Changeset 1363 for LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar
- Timestamp:
- Apr 16, 2010, 11:50:10 AM (15 years ago)
- Location:
- LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar
- Files:
-
- 1 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/calfis_p.F
r1325 r1363 108 108 #include "comvert.h" 109 109 #include "comgeom2.h" 110 #include "iniprint.h" 110 111 #ifdef CPP_MPI 111 112 include 'mpif.h' … … 258 259 debut = .TRUE. 259 260 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 260 PRINT*,'STOP dans calfis' 261 PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 262 PRINT*,' ngridmx jjm iim ' 263 PRINT*,ngridmx,jjm,iim 261 write(lunout,*) 'STOP dans calfis' 262 write(lunout,*) 263 & 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 264 write(lunout,*) ' ngridmx jjm iim ' 265 write(lunout,*) ngridmx,jjm,iim 264 266 STOP 265 267 ENDIF … … 628 630 #ifdef CPP_EARTH 629 631 630 print*,'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 632 !$OMP MASTER 633 write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 634 !$OMP END MASTER 631 635 zdt_split=dtphys/nsplit_phys 632 636 zdufic_omp(:,:)=0. … … 1107 1111 1108 1112 #else 1109 write(*,*) "calfis_p: for now can only work with parallel physics" 1113 write(lunout,*) 1114 & "calfis_p: for now can only work with parallel physics" 1110 1115 stop 1111 1116 #endif -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/exner_hyb.F
r774 r1363 1 1 ! 2 ! $ Header$2 ! $Id $ 3 3 ! 4 4 SUBROUTINE exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf ) … … 51 51 REAL SSUM 52 52 c 53 54 if (llm.eq.1) then 55 ! Specific behaviour for Shallow Water (1 vertical layer) case 53 56 57 ! Sanity checks 58 if (kappa.ne.1) then 59 call abort_gcm("exner_hyb", 60 & "kappa!=1 , but running in Shallow Water mode!!",42) 61 endif 62 if (cpp.ne.r) then 63 call abort_gcm("exner_hyb", 64 & "cpp!=r , but running in Shallow Water mode!!",42) 65 endif 66 67 ! Compute pks(:),pk(:),pkf(:) 68 69 DO ij = 1, ngrid 70 pks(ij) = (cpp/preff) * ps(ij) 71 pk(ij,1) = .5*pks(ij) 72 ENDDO 73 74 CALL SCOPY ( ngrid * llm, pk, 1, pkf, 1 ) 75 CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 76 77 ! our work is done, exit routine 78 return 79 endif ! of if (llm.eq.1) 80 81 54 82 unpl2k = 1.+ 2.* kappa 55 83 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/exner_hyb_p.F
r985 r1363 1 ! 2 ! $Id $ 3 ! 1 4 SUBROUTINE exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf ) 2 5 c … … 51 54 INTEGER ije,ijb,jje,jjb 52 55 c 53 c$OMP BARRIER 56 c$OMP BARRIER 57 58 if (llm.eq.1) then 59 ! Specific behaviour for Shallow Water (1 vertical layer) case 60 61 ! Sanity checks 62 if (kappa.ne.1) then 63 call abort_gcm("exner_hyb", 64 & "kappa!=1 , but running in Shallow Water mode!!",42) 65 endif 66 if (cpp.ne.r) then 67 call abort_gcm("exner_hyb", 68 & "cpp!=r , but running in Shallow Water mode!!",42) 69 endif 70 71 ! Compute pks(:),pk(:),pkf(:) 72 ijb=ij_begin 73 ije=ij_end 74 !$OMP DO SCHEDULE(STATIC) 75 DO ij=ijb, ije 76 pks(ij)=(cpp/preff)*ps(ij) 77 pk(ij,1) = .5*pks(ij) 78 pkf(ij,1)=pk(ij,1) 79 ENDDO 80 !$OMP ENDDO 81 82 !$OMP MASTER 83 if (pole_nord) then 84 DO ij = 1, iim 85 ppn(ij) = aire( ij ) * pks( ij ) 86 ENDDO 87 xpn = SSUM(iim,ppn,1) /apoln 88 89 DO ij = 1, iip1 90 pks( ij ) = xpn 91 pk(ij,1) = .5*pks(ij) 92 pkf(ij,1)=pk(ij,1) 93 ENDDO 94 endif 95 96 if (pole_sud) then 97 DO ij = 1, iim 98 pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm ) 99 ENDDO 100 xps = SSUM(iim,pps,1) /apols 101 102 DO ij = 1, iip1 103 pks( ij+ip1jm ) = xps 104 pk(ij+ip1jm,1)=.5*pks(ij+ip1jm) 105 pkf(ij+ip1jm,1)=pk(ij+ip1jm,1) 106 ENDDO 107 endif 108 !$OMP END MASTER 109 110 jjb=jj_begin 111 jje=jj_end 112 CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 ) 113 114 ! our work is done, exit routine 115 return 116 endif ! of if (llm.eq.1) 117 118 54 119 unpl2k = 1.+ 2.* kappa 55 120 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/iniacademic.F
r1299 r1363 8 8 USE filtreg_mod 9 9 USE infotrac, ONLY : nqtot 10 USE control_mod 11 10 12 11 13 c%W% %G% … … 31 33 c 32 34 c======================================================================= 33 USE control_mod34 35 IMPLICIT NONE 35 36 c----------------------------------------------------------------------- … … 46 47 #include "temps.h" 47 48 #include "iniprint.h" 49 #include "logic.h" 48 50 49 51 c Arguments: … … 55 57 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants 56 58 REAL teta(ip1jmp1,llm) ! temperature potentielle 57 REAL q(ip1jmp1,llm,nqtot) ! champs advectes59 REAL q(ip1jmp1,llm,nqtot) ! champs advectes 58 60 REAL ps(ip1jmp1) ! pression au sol 59 61 REAL masse(ip1jmp1,llm) ! masse d'air … … 84 86 time_0=0. 85 87 day_ref=0 86 88 annee_ref=0 87 89 88 90 im = iim … … 105 107 ang0 = 0. 106 108 109 if (llm.eq.1) then 110 ! specific initializations for the shallow water case 111 kappa=1 112 endif 113 107 114 CALL iniconst 108 115 CALL inigeom 109 116 CALL inifilr 110 117 111 ps=0. 112 phis=0. 118 if (llm.eq.1) then 119 ! initialize fields for the shallow water case, if required 120 if (.not.read_start) then 121 phis(:)=0. 122 q(:,:,1)=1.e-10 123 q(:,:,2)=1.e-15 124 q(:,:,3:nqtot)=0. 125 CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps) 126 endif 127 endif 128 129 if (iflag_phys.eq.2) then 130 ! initializations for the academic case 131 ps(:)=1.e5 132 phis(:)=0. 113 133 c--------------------------------------------------------------------- 114 134 115 taurappel=10.*daysec135 taurappel=10.*daysec 116 136 117 137 c--------------------------------------------------------------------- … … 119 139 c -------------------------------------- 120 140 121 DO l=1,llm122 zsig=ap(l)/preff+bp(l)123 if (zsig.gt.0.3) then124 lsup=l125 tetarappell=1./8.*(-log(zsig)-.5)126 DO j=1,jjp1141 DO l=1,llm 142 zsig=ap(l)/preff+bp(l) 143 if (zsig.gt.0.3) then 144 lsup=l 145 tetarappell=1./8.*(-log(zsig)-.5) 146 DO j=1,jjp1 127 147 ddsin=sin(rlatu(j))-sin(pi/20.) 128 148 tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell) 129 ENDDO130 else149 ENDDO 150 else 131 151 c Choix isotherme au-dessus de 300 mbar 132 do j=1,jjp1133 tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa134 enddo135 endif ! of if (zsig.gt.0.3)136 ENDDO ! of DO l=1,llm137 138 do l=1,llm139 do j=1,jjp1152 do j=1,jjp1 153 tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa 154 enddo 155 endif ! of if (zsig.gt.0.3) 156 ENDDO ! of DO l=1,llm 157 158 do l=1,llm 159 do j=1,jjp1 140 160 do i=1,iip1 141 161 ij=(j-1)*iip1+i 142 162 tetarappel(ij,l)=tetajl(j,l) 143 163 enddo 144 enddo145 enddo164 enddo 165 enddo 146 166 147 167 c call dump2d(jjp1,llm,tetajl,'TEQ ') 148 168 149 ps=1.e5 150 phis=0. 151 CALL pression ( ip1jmp1, ap, bp, ps, p ) 152 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 153 CALL massdair(p,masse) 169 CALL pression ( ip1jmp1, ap, bp, ps, p ) 170 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 171 CALL massdair(p,masse) 154 172 155 173 c intialisation du vent et de la temperature 156 teta(:,:)=tetarappel(:,:)157 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)158 call ugeostr(phi,ucov)159 vcov=0.160 q(:,:,1 )=1.e-10161 q(:,:,2 )=1.e-15162 q(:,:,3:nqtot)=0.174 teta(:,:)=tetarappel(:,:) 175 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi) 176 call ugeostr(phi,ucov) 177 vcov=0. 178 q(:,:,1 )=1.e-10 179 q(:,:,2 )=1.e-15 180 q(:,:,3:nqtot)=0. 163 181 164 182 165 183 c perturbation aleatoire sur la temperature 166 idum = -1167 zz = ran1(idum)168 idum = 0169 do l=1,llm170 do ij=iip2,ip1jm184 idum = -1 185 zz = ran1(idum) 186 idum = 0 187 do l=1,llm 188 do ij=iip2,ip1jm 171 189 teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum)) 172 enddo173 enddo174 175 do l=1,llm176 do ij=1,ip1jmp1,iip1190 enddo 191 enddo 192 193 do l=1,llm 194 do ij=1,ip1jmp1,iip1 177 195 teta(ij+iim,l)=teta(ij,l) 178 enddo179 enddo196 enddo 197 enddo 180 198 181 199 … … 187 205 188 206 c initialisation d'un traceur sur une colonne 189 j=jjp1*3/4 190 i=iip1/2 191 ij=(j-1)*iip1+i 192 q(ij,:,3)=1. 193 207 j=jjp1*3/4 208 i=iip1/2 209 ij=(j-1)*iip1+i 210 q(ij,:,3)=1. 211 endif ! of if (iflag_phys.eq.2) 212 194 213 else 195 214 write(lunout,*)"iniacademic: planet types other than earth", -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/leapfrog_p.F
r1357 r1363 1354 1354 call Gather_Field(ucov,ip1jmp1,llm,0) 1355 1355 call Gather_Field(teta,ip1jmp1,llm,0) 1356 call Gather_Field(pk,ip1jmp1,llm,0) 1356 1357 call Gather_Field(phi,ip1jmp1,llm,0) 1357 1358 do iq=1,nqtot … … 1559 1560 call Gather_Field(ucov,ip1jmp1,llm,0) 1560 1561 call Gather_Field(teta,ip1jmp1,llm,0) 1562 call Gather_Field(pk,ip1jmp1,llm,0) 1561 1563 call Gather_Field(phi,ip1jmp1,llm,0) 1562 1564 do iq=1,nqtot … … 1624 1626 call Gather_Field(phis,ip1jmp1,1,0) 1625 1627 if (mpi_rank==0) then 1626 1628 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) 1627 1629 endif 1628 1630 ! CALL writehist_p(histid, histvid, itau,vcov ,
Note: See TracChangeset
for help on using the changeset viewer.