PGF90 (Version 12.8) 08/30/2020 00:27:47 page 1 Switches: -noasm -nodclchk -nodebug -nodlines -noline -list -idir ../include -inform warn -opt 1 -nosave -object -noonetrip -depchk on -nostandard -nosymbol -noupcase Filename: etafld.f90 ( 1) subroutine etafld ( 2) ( 3) USE mod_vrbls ( 4) USE mod_extra ( 5) USE mod_masks ( 6) implicit none ( 7) ( 8) include 'param_o.h' ( 9) !! include 'extra.comm' ../include/param_o.h ( 1)* integer,parameter :: im0=401 ( 2)* integer, parameter :: nm=6 ( 3)* integer, parameter :: lm = 50 ( 4)* integer, parameter :: nsub = 10 ( 5)* ( 6)* integer, parameter :: im=im0, jm=im ( 7)* integer, parameter :: im1=im-1, jm1=jm-1 ( 8)* ( 9)* integer, parameter :: lm1 = lm-1, lp1 =lm +1 ( 10)* ( 11)* integer, parameter :: ixm = nsub, jym = ixm, nxy = ixm*jym ( 12)* integer, parameter :: ildom = (im - 1)/ixm, jldom = (jm - 1)/jym ( 13)* integer, parameter :: ilm = (im - 1)/ixm +1, jlm = (jm - 1)/jym +1 ( 14)* ( 15)* logical,parameter::flat=.false. ( 16)* logical,parameter::hstst=.false. ( 17)* ( 18)*! integer,parameter::igm=360, jgm = 181 ( 19)* integer,parameter::igm=(im0-1)*4, jgm = (igm/2)+1 ( 20)* real,parameter::alfa=0.0, beta=0.0, gamm=0.0 ( 21)*! real,parameter::alfa=0.*3.1415926/180.,beta=66.*3.1415926/180. & ( 22)*! ,gamm=175.*3.1415926/180. ( 23)* ( 24)*!GSM integer,parameter::lsm=20 ( 25)* integer,parameter::lsm=31 ( 26)* ( 27)*!RESTART ( 28)* ( 29)* character(len=10):: restartdate='2020080412' !restart date to create appropriate folder name ( 10) include 'dynam.comm' ( 11) ../include/dynam.comm ( 1)* real::fadv,fadv2, fadt, rd, f4d, ef4t, fkin ( 2)* real, dimension (lm) :: deta, rdeta, aeta, daeta,f4q2 ( 3)* real, dimension (lp1) :: eta, dfl ( 4)* ( 5)* common/dynam/ fadv,fadv2,fadt,rd,f4d,f4q2,ef4t,fkin,deta,rdeta, & ( 6)* eta,dfl,aeta,daeta ( 7)* ( 8)* ( 9)*!!!!!!!!!!!copy from dynam_comm.h PGF90 (Version 12.8) 08/30/2020 00:27:47 page 2 ( 10)*! real :: fadv, fadv2,fadt, rd, f4d, ef4t, fkin, fcp ( 11)*! real, dimension (lm) :: deta, rdeta, aeta, daeta,f4q2 ( 12)*! real, dimension (lp1) :: eta, dfl ( 13)*! real, dimension (0:im+1,0:jm+1,nm) :: wpdar, f11, f12, f21, f22, & ( 14)*! p11, p12, p21, p22, fdiv, fddmp,fvdiff & ( 15)*! ,hbmsk,hsinp,hcosp ( 16)*! common /dynam/ fadv,fadv2, fadt, rd, f4d,f4q2, ef4t, fkin, & ( 17)*! deta, rdeta, aeta, eta, dfl, daeta, & ( 18)*! wpdar, f11, f12, f21, f22, & ( 19)*! p11, p12, p21, p22, fcp, fdiv, fddmp,hsinp,hcosp,& ( 20)*! fvdiff,hbmsk ( 12) real,parameter::gi=1./9.80616,D608=0.608,H1=1. ( 13) integer::i,j,n,l ( 14) real,dimension(0:im+1,0:jm+1,nm,2)::fi ( 15) ( 16) rd=287.04 ( 17) ( 18) ( 19) call blosfc ( 20) ! ( 21) ! COMPUTE HEIGHT AT INTERFACES. ( 22) ! SET SURFACE VALUES. ( 23) do n=1,nm ( 24) DO J=1,jm ( 25) DO I=1,IM ( 26) ZINT(I,J,n,LP1)=FIS(I,J,n)*GI ( 27) FI(I,J,n,1)=FIS(I,J,n) ( 28) ! if(i.eq.21.and.j.eq.20.and.n.eq.13)then ( 29) ! print *,i,j,n,zint(i,j,n,lp1),fis(i,j,n) ( 30) ! endif ( 31) ENDDO ( 32) ENDDO ( 33) ENDDO ( 34) ( 35) ( 36) do n=1,nm ( 37) DO J=1,jm ( 38) DO I=1,IM ( 39) ! ( 40) ! COMPUTE VALUES FROM THE SURFACE UP. ( 41) ! ( 42) DO 80 L=LM,1,-1 ( 43) FI(I,J,n,2)=htm(i,j,n,l)*T(I,J,n,L)*(Q(I,J,n,L)*D608+H1)*Rd* & ( 44) (ALPINT(I,J,n,L+1)-ALPINT(I,J,n,L))+FI(I,J,n,1) ( 45) ZINT(I,J,n,L)=FI(I,J,n,2)*GI ( 46) FI(I,J,n,1)=FI(I,J,n,2) ( 47) ! if(i.eq.45.and.n.eq.2)then ( 48) ! if(l.eq.16)then ( 49) ! print *,i,j,n,l,htm(i,j,n,l),t(i,j,n,l),alpint(i,j,n,l+1),alpint(i,j,n,l),zint(i,j,n,l) ( 50) ! print *,i,j,n,zint(i,j,n,l) ( 51) ! endif ( 52) 80 CONTINUE ( 53) ENDDO ( 54) ENDDO ( 55) ENDDO ( 56) ( 57) do n=1,nm ( 58) DO J=1,jm PGF90 (Version 12.8) 08/30/2020 00:27:47 page 3 ( 59) DO I=1,IM ( 60) ! ( 61) ! COMPUTE VALUES below THE SURFACE . ( 62) ! ( 63) DO L=lmh(i,j,n)+1,lm ( 64) ZINT(I,J,n,L+1)=dfl(l+1)*GI ( 65) ENDDO ( 66) ( 67) ENDDO ( 68) ENDDO ( 69) ENDDO ( 70) ( 71) ( 72) end subroutine etafld ( 73)