! ********************************************************************* ! * * ! * subroutine sim2ep * ! * * ! ********************************************************************* ! Single Precision Version 1.4 ! Written by Gordon A. Fenton, Dalhousie University, Jan 31, 2001 ! Latest Update: Feb 22, 2005 ! ! PURPOSE simulates soil property fields for MREARTH2D ! ! DESCRIPTION ! This routine simulates up to 7 soil property fields (cohesion, friction ! angle, dilation angle, elastic modulus, Poisson's ratio, unit weight, and ! pressure coefficient), which are possibly intercorrelated. Individual ! fields are generated as standard Gaussian random fields using the 2-D ! Local Average Subdivision (LAS) algorithm. These fields are then combined ! to produce correlated standard Gaussian fields using the Covariance Matrix ! Decomposition approach. Finally the individual fields are transformed so ! that they have the desired marginal distributions. These transformations ! are as follows; ! ! P(x,y) = mean + sd*G(x,y) if normally distributed ! ! P(x,y) = exp{ log-mean + log-sd*G(x,y) }if lognormally distributed ! ! P(x,y) = a + 0.5*(b-a)*[ 1 + tanh((m + s*G(x,y))/2*pi) ] ! if bounded ! ! P(x,y) = a + b*f(phi) if a function of friction angle ! ! where P(x,y) is the desired random field (one of the soil properties), ! G(x,y) is one of the standard correlated Gaussian fields, and (mean,sd) ! and (a,b,m,s) are parameters of the distributions. Note that the last ! transformation, f(phi), does not involve the production of an independent ! random field. The soil property in question is derived entirely from the ! friction angle field. ! ! If the property is deterministic, the entire field is simply set to the ! mean. ! ! ARGUMENTS ! ! istat unit number connected to a file to which the input data is to ! echoed if echo is true. (input) ! ! iterm unit number connected to the screen. If verbos is true, then ! error and warning messages are also sent to the screen. (input) ! ! verbos logical flag which is true if error, warning, and progress ! messages are allowed to be sent to the screen. (input) ! ! phifld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) cohesion field. ! (output) ! ! phifld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) friction angle ! field. (output) ! ! psifld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) dilation angle ! field. (output) ! ! efld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) elastic modulus ! field. (output) ! ! vfld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) Poisson's ratio ! field. (output) ! ! gamfld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) unit weight ! field. (output) ! ! k0fld real array of size at least (nxe x nye) which on output ! will contain the (optionally random) pressure coefficient ! field. (output) ! ! nrfx integer giving the number of cells in the x-direction in the ! random fields phifld, ..., k0fld. This is normally equal to nxe, ! but if nxe is not an integer of the form nxe = k1*(2**m), ! where m is a non-negative integer, and k1 is a positive ! integer with k1*k2 < MXK (see chknxe) then nrfx is the next ! larger possible integer that does satisfy this requirement ! of LAS2G. (input) ! ! nrfy integer giving the number of cells in the y-direction in the ! random fields above. This is normally equal to nye, but if ! nye is not an integer of the form nye = k2*(2**m), where m is ! a non-negative integer, and k2 is a positive integer with ! k1*k2 < MXK (see chknxe) then nrfy is the next larger ! possible integer that does satisfy this requirement of LAS2G. ! (input) ! ! c real vector of length at least 7 containing the parameters of ! the soil cohesion. Notably, ! c(1) = mean cohesion, ! c(2) = cohesion standard deviation, ! c(3) = cohesion distribution type; ! = 0.0 if cohesion is deterministic (at mean value) ! = 1.0 if cohesion is normally distributed ! = 2.0 if cohesion is lognormally distributed (logn) ! = 3.0 if cohesion is bounded ! = 4.0 if cohesion is a function of phi ! c(4) = lower bound (bounded), or mean log-cohesion (logn), ! or constant in functional relationship (f(phi)) ! c(5) = upper bound (bounded), or sd of log-cohesion (logn), ! or slope in functional relationship (f(phi)) ! c(6) = m parameter (if bounded), or function type (f(phi)) ! where in the last case, ! c(6) = 0.0 for 1*phi ! c(6) = 1.0 for sin(phi) ! c(6) = 2.0 for tan(phi) ! c(7) = s parameter (if bounded) ! If c is bounded or functional, then c(1) and c(2) are ignored ! and the parameters c(4) through c(7) or c(4) through c(6) ! completely describe the distribution or function, respectively. ! (input) ! ! phi real vector of length at least 7 containing the parameters of ! soil friction angle (or of tan(phi) if ltanfi is true). ! See `c' for what the various elements of phi contain. (input) ! ! psi real vector of length at least 7 containing the parameters of ! soil dilation angle. See `c' for what the various elements of ! psi contain. (input) ! ! e real vector of length at least 7 containing the parameters of ! soil elastic modulus. See `c' for what the various elements of ! e contain. (input) ! ! v real vector of length at least 7 containing the parameters of ! soil Poisson ratio. See `c' for what the various elements of ! v contain. (input) ! ! gam real vector of length at least 7 containing the parameters of ! soil unit weight. See `c' for what the various elements of ! gam contain. (input) ! ! k0 real vector of length at least 7 containing the parameters of ! soil pressure coefficient. See `c' for what the various ! elements of k0 contain. (input) ! ! R real array of size at least 7 x 7 which is assumed to ! contain the correlation matrix between the 7 (possibly) ! random soil properties. Indexing into R is as follows; ! 1 = cohesion ! 2 = friction angle ! 3 = dilation angle ! 4 = elastic modulus ! 5 = Poisson's ratio ! 6 = unit weight ! 7 = pressure coefficient ! (input) ! ! ltanfi logical flag which is true if the parameters specified for ! phi actually refer to the random variable tan(phi). That is ! if ltanfi is true, then the friction angle field is specified ! by making tan(phi) the random variable, rather than phi ! directly. (input) ! ! lxfld logical flag which is true if more than one soil property ! are cross-correlated. That is, if all soil properties are ! independent and/or deterministic, then lxfld is false. (input) ! ! thx real value giving the x-direction scale of fluctuation ! (or, at least, this is a parameter of the variance function). ! (input) ! ! thy real value giving the y-direction scale of fluctuation ! (or, at least, this is another parameter of the variance ! function). (input) ! ! nxe integer giving the number of elements describing the soil ! mass in the x-direction (horizontally). (input) ! ! nye integer giving the number of elements describing the soil ! mass in the y-direction (vertically). (input) ! ! dx real value giving the physical size of an element in the ! x-direction. (input) ! ! dy real value giving the physical size of an element in the ! y-direction. (input) ! ! dmpfld logical flag which is true if a random field is to be ! plotted to *.fld. (input) ! ! nfld integer giving the realization number of the random field ! which is to be plotted to *.fld. (input) ! ! jfld integer denoting which random field is to be plotted; ! = 1 for the cohesion (c) field, ! = 2 for the friction angle (phi) field, ! = 3 for the dilation angle (psi) field, ! = 4 for the elastic modulus (psi) field, ! = 5 for the poisson ratio (psi) field, ! = 6 for the unit weight (gam) field, ! = 7 for the pressure coefficient (k0) field. ! (input) ! ! ifld unit number connected to the file to which the random field ! plot is to be written in the event that dmpfld is true. ! (input) ! ! job character string containing the main title of the run. ! (input) ! ! sub1 character string, which on output will contain the first ! subtitle for this run. (output) ! ! sub2 character string, which on output will contain the second ! subtitle for this run. (output) ! ! varfnc character string containing the name of the variance ! function controlling the random fields. Possible variance ! functions are ! `dlavx2' - 2-D exponentially decaying (Markov) model ! requires X- and Y-direction scales of fluctuation ! `dlafr2' - 2-D isotropic fractional Gaussian noise model ! requires (H,delta) as parameters. In this case, ! thx is H, and delta is the minimum element ! dimension. ! `dlsep2' - 2-D separable (1D x 1D) Markov model ! requires X- and Y-direction scales of fluctuation ! `dlsfr2' - 2-D separable fractional Gaussian noise model ! requires (H_x,H_y,delta) as parameters. In this ! case, thx is H_x, thy is H_y, and delta is the ! minimum element dimension. ! `dlspx2' - 2-D separable Gaussian decaying model ! requires X- and Y-direction scales of fluctuation ! (input) ! ! kseed integer giving the seed to be used to initialize the ! pseudo-random number generator. Subsequent runs using ! the same seed will result in the same sequence of random ! numbers. (input) ! ! debug logical flag which is true if debug information is to be ! sent to the *.stt file. (input) ! ! REVISION HISTORY: ! 1.1 removed lvarfn from common block dparam. (Apr 26/01) ! 1.2 added ltanfi; now generate nrfx x nrfy fields (Aug 15/02) ! 1.3 added error output if covariance function name unknown (Sep 9/02) ! 1.4 reordered numbering of f(phi) function types (0=1,1=sin,2=tan) ! (Feb 22/05) !------------------------------------------------------------------------- subroutine sim2ep2(istat,iterm,verbos,phifld, & nrfx,nrfy,phi, & ltanfi,lxfld,thx,thy,dx,dy, & dmpfld,nfld,jfld,ifld,job,sub1,sub2,varfnc, & kseed,debug) real phifld(nrfx,*) real phi(*) real thx, thy integer istat, iterm, nfld, jfld, ifld, kseed integer nrfx, nrfy character*(*) job, sub1, sub2, varfnc logical verbos, dmpfld, debug, liid2, shofld, lxfld, ltanfi real*8 dlavv2, dlsep2, dlspx2, dlafr2, dlsfr2 real*8 dvar, dpb, dthx, dthy, dthz, ddx, ddy save xl2, yl2, ienter2, liid2 external dlavv2, dlsep2, dlspx2, dlafr2, dlsfr2 common/dparam2/ dvar, dpb, dthx, dthy, dthz data zero/0.0/ data ienter2/0/ 1 format(a,a) !-------------------------------------- initialize ------------------------- ! compute required field size (once) ienter2 = ienter2 + 1 if( ienter2 .eq. 1 ) then liid2 = ((thx .eq. zero) .and. (thy .eq. zero)) xl2 = float(nrfx)*dx yl2 = float(nrfy)*dy if( debug ) write(istat,1)'SIM2EP: setting field parameters...' if( .not. liid2 ) then ! set variance fnc parameters dvar = 1.d0 dthx = thx dthy = thy if( varfnc .eq. 'dlafr2' .or. varfnc .eq. 'dlsfr2' ) then dpb = dx if( dy .lt. dx ) dpb = dy endif ! initialize LAS2G if( varfnc .eq. 'dlavv2' ) then call las2g2(phifld,nrfx,nrfy,xl2,yl2,dlavv2,kseed,-1,istat) elseif( varfnc .eq. 'dlsep2' ) then call las2g2(phifld,nrfx,nrfy,xl2,yl2,dlsep2,kseed,-1,istat) elseif( varfnc .eq. 'dlspx2' ) then call las2g2(phifld,nrfx,nrfy,xl2,yl2,dlspx2,kseed,-1,istat) elseif( varfnc .eq. 'dlafr2' ) then call las2g2(phifld,nrfx,nrfy,xl2,yl2,dlafr2,kseed,-1,istat) elseif( varfnc .eq. 'dlsfr2' ) then call las2g2(phifld,nrfx,nrfy,xl2,yl2,dlsfr2,kseed,-1,istat) else if( verbos ) then write(iterm,1) & '*** Error: unknown variance function name: ', varfnc endif write(istat,1) & '*** Error: unknown variance function name: ', varfnc stop endif endif endif ! are we going to plot anything? shofld = dmpfld .and. (nfld .eq. ienter2) ! now produce up to 7 standard normal fields ! for friction angle... call genfld2(istat,phifld,phi,nrfx,nrfy,xl2,yl2,varfnc,kseed,liid2) ! plot the random field? if( shofld ) then if( jfld .eq. 1 ) then call pltfld( job,sub1,sub2,phifld,nrfx,nrfx,nrfy,xl2,yl2, & '(Underlying) Friction Angle Field',ifld ) endif endif ! convert to final fields ! (do friction angle first, since other ! properties may depend on it) ! for friction angle... call genprp(phifld,phi,phifld,nrfx,nrfy,ltanfi) return end