Changeset 230 for LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F
- Timestamp:
- Jun 20, 2001, 3:29:52 PM (23 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F
r177 r230 1 c 2 c $Header$ 3 c 1 4 SUBROUTINE phystokenc ( 2 5 I nlon,nlev,pdtphys,rlon,rlat, 3 I p mfu, pmfd, pen_u, pde_u, pen_d, pde_d,6 I pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 4 7 I pcoefh,yu1,yv1,ftsol,pctsrf, 5 I frac_impa,frac_nucl, 6 I pphis,paire,dtime,itap, 7 O physid) 8 I pfrac_impa,pfrac_nucl, 9 I pphis,paire,dtime,itap) 8 10 USE ioipsl 9 11 USE histcom … … 36 38 real pdtphys ! pas d'integration pour la physique (seconde) 37 39 c 38 integer physid, itap 39 integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 40 integer physid, itap,ndex(1) 40 41 41 42 c convection: … … 48 49 REAL pen_d(klon,klev) ! flux entraine dans le panache descendant 49 50 REAL pde_d(klon,klev) ! flux detraine dans le panache descendant 51 REAL pt(klon,klev) 50 52 c 51 53 REAL rlon(klon), rlat(klon), dtime … … 62 64 c ---------- 63 65 c 64 REAL frac_impa(klon,klev)65 REAL frac_nucl(klon,klev)66 REAL pfrac_impa(klon,klev) 67 REAL pfrac_nucl(klon,klev) 66 68 c 67 69 c Arguments necessaires pour les sources et puits de traceur … … 80 82 REAL de_d(klon,klev) ! flux detraine dans le panache descendant 81 83 REAL coefh(klon,klev) ! flux detraine dans le panache descendant 84 REAL t(klon,klev) 85 REAL frac_impa(klon,klev) 86 REAL frac_nucl(klon,klev) 87 REAL rain(klon) 82 88 83 89 REAL pyu1(klon),pyv1(klon) … … 90 96 integer iadvtr,irec 91 97 real zmin,zmax 92 logical ok_sync 93 94 save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 98 99 save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum 95 100 save iadvtr,irec 101 save frac_impa,frac_nucl,rain 96 102 save pyu1,pyv1,pftsol,ppsrf 97 103 … … 101 107 c====================================================================== 102 108 103 ok_sync = .true. 104 105 c print*,'iadvtr= ',iadvtr 106 c print*,'istphy= ',istphy 107 c print*,'istdyn= ',istdyn 109 print*,'iadvtr= ',iadvtr 110 print*,'istphy= ',istphy 111 print*,'istdyn= ',istdyn 108 112 109 113 IF (iadvtr.eq.0) THEN … … 112 116 . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid) 113 117 114 c write(*,*) 'apres initphysto ds phystokenc' 115 118 write(*,*) 'apres initphysto ds phystokenc' 119 120 ndex(1) = 0 121 i=itap 122 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 123 CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex) 124 c 125 i=itap 126 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 127 CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex) 116 128 117 129 ENDIF 118 130 c 119 ndex2d = 0120 ndex3d = 0121 i=itap122 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)123 CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)124 c125 i=itap126 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)127 CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)128 129 131 iadvtr=iadvtr+1 130 132 c 131 IF(mod(iadvtr,istphy).eq.0) THEN 132 c 133 c normalisation par le temps cumule 133 c 134 c reinitialisation des champs cumules 135 if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then 136 print*,'reinitialisation des champs cumules 137 s a iadvtr=',iadvtr 134 138 do k=1,klev 135 139 do i=1,klon 136 mfu(i,k)=mfu(i,k)/dtcum 137 mfd(i,k)=mfd(i,k)/dtcum 138 en_u(i,k)=en_u(i,k)/dtcum 139 de_u(i,k)=de_u(i,k)/dtcum 140 en_d(i,k)=en_d(i,k)/dtcum 141 de_d(i,k)=de_d(i,k)/dtcum 142 coefh(i,k)=coefh(i,k)/dtcum 143 enddo 144 enddo 145 do i=1,klon 146 pyv1(i)=pyv1(i)/dtcum 147 pyu1(i)=pyu1(i)/dtcum 148 end do 149 do k=1,nbsrf 150 do i=1,klon 151 pftsol(i,k)=pftsol(i,k)/dtcum 152 pftsol1(i) = pftsol(i,1) 153 pftsol2(i) = pftsol(i,2) 154 pftsol3(i) = pftsol(i,3) 155 pftsol4(i) = pftsol(i,4) 156 157 ppsrf(i,k)=ppsrf(i,k)/dtcum 158 ppsrf1(i) = ppsrf(i,1) 159 ppsrf2(i) = ppsrf(i,2) 160 ppsrf3(i) = ppsrf(i,3) 161 ppsrf4(i) = ppsrf(i,4) 162 163 enddo 164 enddo 165 c 166 c ecriture des champs 167 c 168 irec=irec+1 169 170 ccccc 171 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 172 CALL histwrite(physid,"mfu",itap,zx_tmp_3d, 173 . iim*(jjm+1)*klev,ndex3d) 174 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 175 CALL histwrite(physid,"mfd",itap,zx_tmp_3d, 176 . iim*(jjm+1)*klev,ndex3d) 177 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 178 CALL histwrite(physid,"en_u",itap,zx_tmp_3d, 179 . iim*(jjm+1)*klev,ndex3d) 180 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 181 CALL histwrite(physid,"de_u",itap,zx_tmp_3d, 182 . iim*(jjm+1)*klev,ndex3d) 183 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 184 CALL histwrite(physid,"en_d",itap,zx_tmp_3d, 185 . iim*(jjm+1)*klev,ndex3d) 186 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 187 CALL histwrite(physid,"de_d",itap,zx_tmp_3d, 188 . iim*(jjm+1)*klev,ndex3d) 189 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 190 CALL histwrite(physid,"coefh",itap,zx_tmp_3d, 191 . iim*(jjm+1)*klev,ndex3d) 192 cccc 193 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 194 CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d, 195 . iim*(jjm+1)*klev,ndex3d) 196 197 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 198 CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d, 199 . iim*(jjm+1)*klev,ndex3d) 200 201 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 202 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1), 203 . ndex2d) 204 205 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 206 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1) 207 . ,ndex2d) 208 209 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 210 CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d, 211 . iim*(jjm+1),ndex2d) 212 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 213 CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d, 214 . iim*(jjm+1),ndex2d) 215 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 216 CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d, 217 . iim*(jjm+1),ndex2d) 218 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 219 CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d, 220 . iim*(jjm+1),ndex2d) 221 222 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 223 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, 224 . iim*(jjm+1),ndex2d) 225 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 226 CALL histwrite(physid,"psrf2",itap,zx_tmp_2d, 227 . iim*(jjm+1),ndex2d) 228 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 229 CALL histwrite(physid,"psrf3",itap,zx_tmp_2d, 230 . iim*(jjm+1),ndex2d) 231 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 232 CALL histwrite(physid,"psrf4",itap,zx_tmp_2d, 233 . iim*(jjm+1),ndex2d) 234 235 if (ok_sync) call histsync(physid) 236 237 c 238 cAA Test sur la valeur des coefficients de lessivage 239 c 240 zmin=1e33 241 zmax=-1e33 242 do k=1,klev 243 do i=1,klon 244 zmax=max(zmax,frac_nucl(i,k)) 245 zmin=min(zmin,frac_nucl(i,k)) 246 enddo 247 enddo 248 Print*,'------ coefs de lessivage (min et max) --------' 249 Print*,'facteur de nucleation ',zmin,zmax 250 zmin=1e33 251 zmax=-1e33 252 do k=1,klev 253 do i=1,klon 254 zmax=max(zmax,frac_impa(i,k)) 255 zmin=min(zmin,frac_impa(i,k)) 256 enddo 257 enddo 258 Print*,'facteur d impaction ',zmin,zmax 259 260 ENDIF 261 262 c reinitialisation des champs cumules 263 if (mod(iadvtr,istphy).eq.1) then 264 do k=1,klev 265 do i=1,klon 140 frac_impa(i,k)=1. 141 frac_nucl(i,k)=1. 266 142 mfu(i,k)=0. 267 143 mfd(i,k)=0. … … 271 147 de_d(i,k)=0. 272 148 coefh(i,k)=0. 149 t(i,k)=0. 273 150 enddo 274 151 enddo 275 152 do i=1,klon 153 rain(i)=0. 276 154 pyv1(i)=0. 277 155 pyu1(i)=0. … … 289 167 do k=1,klev 290 168 do i=1,klon 169 frac_impa(i,k)=frac_impa(i,k)*pfrac_impa(i,k) 170 frac_nucl(i,k)=frac_nucl(i,k)*pfrac_nucl(i,k) 291 171 mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys 292 172 mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys … … 296 176 de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys 297 177 coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys 178 t(i,k)=t(i,k)+pt(i,k)*pdtphys 298 179 enddo 299 180 enddo … … 310 191 311 192 dtcum=dtcum+pdtphys 193 c 194 IF(mod(iadvtr,istphy).eq.0) THEN 195 c 196 c normalisation par le temps cumule 197 do k=1,klev 198 do i=1,klon 199 c frac_impa=frac_impa : c'est la fraction cumulee qu'on stoke 200 c frac_nucl=frac_nucl : c'est la fraction cumulee qu'on stoke 201 mfu(i,k)=mfu(i,k)/dtcum 202 mfd(i,k)=mfd(i,k)/dtcum 203 en_u(i,k)=en_u(i,k)/dtcum 204 de_u(i,k)=de_u(i,k)/dtcum 205 en_d(i,k)=en_d(i,k)/dtcum 206 de_d(i,k)=de_d(i,k)/dtcum 207 coefh(i,k)=coefh(i,k)/dtcum 208 t(i,k)=t(i,k)/dtcum 209 enddo 210 enddo 211 do i=1,klon 212 rain(i)=rain(i)/dtcum 213 pyv1(i)=pyv1(i)/dtcum 214 pyu1(i)=pyu1(i)/dtcum 215 end do 216 c modif abderr 23 11 00 do k=1,nbsrf 217 do i=1,klon 218 do k=1,nbsrf 219 pftsol(i,k)=pftsol(i,k)/dtcum 220 ppsrf(i,k)=ppsrf(i,k)/dtcum 221 enddo 222 pftsol1(i) = pftsol(i,1) 223 pftsol2(i) = pftsol(i,2) 224 pftsol3(i) = pftsol(i,3) 225 pftsol4(i) = pftsol(i,4) 226 227 c ppsrf(i,k)=ppsrf(i,k)/dtcum 228 ppsrf1(i) = ppsrf(i,1) 229 ppsrf2(i) = ppsrf(i,2) 230 ppsrf3(i) = ppsrf(i,3) 231 ppsrf4(i) = ppsrf(i,4) 232 233 enddo 234 c enddo 235 c 236 c ecriture des champs 237 c 238 irec=irec+1 239 240 ccccc 241 print*,'AVANT ECRITURE' 242 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d) 243 CALL histwrite(physid,"t",itap,zx_tmp_3d, 244 . iim*(jjm+1)*klev,ndex) 245 print*,'APRES ECRITURE' 246 247 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d) 248 CALL histwrite(physid,"mfu",itap,zx_tmp_3d, 249 . iim*(jjm+1)*klev,ndex) 250 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d) 251 CALL histwrite(physid,"mfd",itap,zx_tmp_3d, 252 . iim*(jjm+1)*klev,ndex) 253 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d) 254 CALL histwrite(physid,"en_u",itap,zx_tmp_3d, 255 . iim*(jjm+1)*klev,ndex) 256 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d) 257 CALL histwrite(physid,"de_u",itap,zx_tmp_3d, 258 . iim*(jjm+1)*klev,ndex) 259 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d) 260 CALL histwrite(physid,"en_d",itap,zx_tmp_3d, 261 . iim*(jjm+1)*klev,ndex) 262 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d) 263 CALL histwrite(physid,"de_d",itap,zx_tmp_3d, 264 . iim*(jjm+1)*klev,ndex) 265 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d) 266 CALL histwrite(physid,"coefh",itap,zx_tmp_3d, 267 . iim*(jjm+1)*klev,ndex) 268 cccc 269 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d) 270 CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d, 271 . iim*(jjm+1)*klev,ndex) 272 273 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d) 274 CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d, 275 . iim*(jjm+1)*klev,ndex) 276 277 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d) 278 CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex) 279 280 CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d) 281 CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex) 282 283 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d) 284 CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d, 285 . iim*(jjm+1),ndex) 286 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d) 287 CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d, 288 . iim*(jjm+1),ndex) 289 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d) 290 CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d, 291 . iim*(jjm+1),ndex) 292 293 c 294 CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d) 295 CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d, 296 . iim*(jjm+1),ndex) 297 298 CALL gr_fi_ecrit(1,klon,iim,jjm+1, rain, zx_tmp_2d) 299 CALL histwrite(physid,"rain",itap,zx_tmp_2d, 300 . iim*(jjm+1),ndex) 301 302 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d) 303 CALL histwrite(physid,"psrf1",itap,zx_tmp_2d, 304 . iim*(jjm+1),ndex) 305 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d) 306 CALL histwrite(physid,"psrf2",itap,zx_tmp_2d, 307 . iim*(jjm+1),ndex) 308 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d) 309 CALL histwrite(physid,"psrf3",itap,zx_tmp_2d, 310 . iim*(jjm+1),ndex) 311 CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d) 312 CALL histwrite(physid,"psrf4",itap,zx_tmp_2d, 313 . iim*(jjm+1),ndex) 314 315 c 316 cAA Test sur la valeur des coefficients de lessivage 317 c 318 zmin=1e33 319 zmax=-1e33 320 do k=1,klev 321 do i=1,klon 322 zmax=max(zmax,frac_nucl(i,k)) 323 zmin=min(zmin,frac_nucl(i,k)) 324 enddo 325 enddo 326 Print*,'------ coefs de lessivage (min et max) --------' 327 Print*,'facteur de nucleation ',zmin,zmax 328 zmin=1e33 329 zmax=-1e33 330 do k=1,klev 331 do i=1,klon 332 zmax=max(zmax,frac_impa(i,k)) 333 zmin=min(zmin,frac_impa(i,k)) 334 enddo 335 enddo 336 Print*,'facteur d impaction ',zmin,zmax 337 338 ENDIF 339 312 340 313 341 RETURN
Note: See TracChangeset
for help on using the changeset viewer.
