Changeset 53 for LMDZ.3.3/trunk
- Timestamp:
- Feb 18, 2000, 12:37:13 PM (25 years ago)
- Location:
- LMDZ.3.3/trunk/libf/phylmd
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/trunk/libf/phylmd/physiq.F
r48 r53 56 56 #include "clesphys.h" 57 57 #include "control.h" 58 #include "temps.h" 58 59 c====================================================================== 59 60 LOGICAL check ! Verifier la conservation du modele en eau … … 282 283 REAL yv1(klon) ! vents dans la premiere couche V 283 284 LOGICAL offline ! Controle du stockage ds "physique" 284 PARAMETER (offline=.FALSE.) 285 PARAMETER (offline=.true.) 286 INTEGER physid 285 287 REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction 286 288 save pfrac_impa … … 671 673 IF (ok_journe) THEN 672 674 c 673 C CALL ymds2ju(1900, 1, 1, 0.0, zjulian) 674 CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian) 675 zjulian = zjulian + dayref 675 CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) 676 zjulian = zjulian + day_ini 676 677 c 677 678 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) … … 824 825 ndex3d = 0 825 826 c 826 Cess i = NINT(zout/zsto)827 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)828 Cess CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)829 c830 Cess i = NINT(zout/zsto)831 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)832 Cess CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)833 c834 827 ENDIF ! fin de test sur ok_journe 835 828 c 836 829 IF (ok_mensuel) THEN 837 830 c 838 c CALL ymds2ju(1900, 1, 1, 0.0, zjulian) 839 CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian) 840 zjulian = zjulian + dayref 831 CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) 832 zjulian = zjulian + day_ini 841 833 c 842 834 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) … … 1172 1164 ndex3d = 0 1173 1165 c 1174 Cess i = NINT(zout/zsto)1175 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)1176 Cess CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)1177 C1178 Cess i = NINT(zout/zsto)1179 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)1180 Cess CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)1181 c1182 1166 ENDIF ! fin de test sur ok_mensuel 1183 1167 c … … 1185 1169 IF (ok_instan) THEN 1186 1170 c 1187 c CALL ymds2ju(1900, 1, 1, 0.0, zjulian) 1188 CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian) 1189 zjulian = zjulian + dayref 1171 CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) 1172 zjulian = zjulian + day_ini 1190 1173 c 1191 1174 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) … … 1253 1236 ndex2d = 0 1254 1237 ndex3d = 0 1255 c1256 Cess i = NINT(zout/zsto)1257 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)1258 Cess CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)1259 c1260 Cess i = NINT(zout/zsto)1261 Cess CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)1262 Cess CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)1263 1238 c 1264 1239 ENDIF … … 1943 1918 C la physique s'applique 1944 1919 C 1945 write(*,*) 'Phytrac= '1946 1920 call phytrac (rnpb, 1947 1921 I debut, … … 1955 1929 O tr_seri) 1956 1930 1957 write(*,*) 'OFFLINE= ', offline1958 1931 IF (offline) THEN 1959 write(*,*) 'OFFLINE= ', offline 1960 call phystoke(1961 I nlon,nlev,pdtphys, 1932 1933 call phystokenc ( 1934 I nlon,nlev,pdtphys,rlon,rlat, 1962 1935 I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 1963 1936 I ycoefh,yu1,yv1,ftsol,pctsrf, 1964 I frac_impa, frac_nucl) 1937 I frac_impa, frac_nucl, 1938 I pphis,paire,dtime,itap, 1939 O physid) 1965 1940 1966 1941 ENDIF -
LMDZ.3.3/trunk/libf/phylmd/phytrac.F
r2 r53 28 28 #include "indicesol.h" 29 29 #include "control.h" 30 #include "temps.h" 30 31 c====================================================================== 31 32 … … 130 131 INTEGER nid_tra 131 132 SAVE nid_tra 132 INTEGER ndex (1)133 INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 133 134 REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev) 134 135 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) … … 140 141 INTEGER ecrit_tra 141 142 SAVE ecrit_tra 143 logical ok_sync 144 parameter (ok_sync = .true.) 142 145 C 143 146 C nature du traceur … … 201 204 modname='phytrac' 202 205 203 206 c print*,'DANS PHYTRAC debutphy=',debutphy 204 207 205 208 ecrit_tra = NINT(86400./pdtphys *ecritphy) 209 zsto = pdtphys 210 zout = pdtphys * FLOAT(ecrit_tra) 206 211 if (debutphy) then 207 212 … … 217 222 itra=0 218 223 C 219 CALL ymds2ju(anne eref, 1, 1, 0.0, zjulian)220 zjulian = zjulian + day ref224 CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) 225 zjulian = zjulian + day_ini 221 226 c 222 227 CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon) … … 237 242 C CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb", 238 243 C . klev, presnivs, nvert) 239 zsto = pdtphys240 zout = pdtphys * FLOAT(ecrit_tra)241 244 c 242 245 CALL histdef(nid_tra, "phis", "Surface geop. height", "-", … … 266 269 ENDDO 267 270 CALL histend(nid_tra) 268 ndex(1) = 0 269 c 270 i = NINT(zout/zsto) 271 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 272 CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex) 273 C 274 i = NINT(zout/zsto) 275 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 276 CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex) 277 c 271 278 272 c====================================================================== 279 273 c Initialisation de certaines variables pour le Rn et le Pb … … 282 276 c Initialisation du traceur dans le sol (couche limite radonique) 283 277 c 284 278 c print*,'valeur de debut dans phytrac :',debutphy 285 279 do it=1,nqmax 286 280 do i=1,klon … … 327 321 if (convection) then 328 322 329 323 c print*,'Pas de temps dans phytrac : ',pdtphys 330 324 DO it=1, nqmax 331 325 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, … … 339 333 CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn) 340 334 ENDDO 341 335 c print*,'apres nflxtr' 342 336 343 337 … … 348 342 c====================================================================== 349 343 350 344 c print*,'avant couchelimite' 351 345 if (couchelimite) then 352 346 … … 359 353 C maf modif pour tenir compte du cas rnpb + traceur 360 354 DO it=1, nqmax 361 355 c print *,'it',it,clsol(it) 362 356 if (clsol(it)) then ! couche limite avec quantite dans le sol calculee 363 357 CALL cltracrn(it, pdtphys, yu1, yv1, … … 407 401 endif ! couche limite 408 402 409 403 c print*,'apres couchelimite' 410 404 411 405 c====================================================================== … … 438 432 IF (lessivage) THEN 439 433 440 434 c print*,'avant lessivage' 441 435 442 436 DO it = 1, nqmax … … 497 491 ENDDO 498 492 c 499 493 c print*,'apres lessivage' 500 494 ENDIF 501 495 Cc … … 511 505 ENDDO 512 506 itra=itra+1 513 ndex(1) = 0 507 508 C 509 C Sorties IOIPSL 510 ndex2d = 0 511 ndex3d = 0 512 c 513 c write(*,*)'sorties ioipsl phytrac',zsto,zout 514 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 515 CALL histwrite(nid_tra,"phis",itra,zx_tmp_2d,iim*(jjm+1),ndex2d) 516 C 517 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 518 CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,iim*(jjm+1),ndex2d) 514 519 DO it=1,nqmax 515 520 IF (it.LE.99) THEN … … 518 523 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d) 519 524 CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d, 520 . iim*(jjm+1)*klev,ndex )525 . iim*(jjm+1)*klev,ndex3d) 521 526 IF (lessivage) THEN 522 527 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d) 523 528 CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d, 524 . iim*(jjm+1)*klev,ndex )529 . iim*(jjm+1)*klev,ndex3d) 525 530 ENDIF 526 531 ELSE … … 529 534 ENDIF 530 535 ENDDO 536 if (ok_sync) call histsync(nid_tra) 531 537 532 538 RETURN
Note: See TracChangeset
for help on using the changeset viewer.