Changeset 230 for LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F
- Timestamp:
- Jun 20, 2001, 3:29:52 PM (23 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F
r177 r230 1 c 2 c $Header$ 3 c 1 4 SUBROUTINE phytrac (rnpb, 2 I debutphy, 5 I debutphy,lafin, 3 6 I nqmax, 4 7 I nlon,nlev,pdtphys, … … 29 32 #include "dimphy.h" 30 33 #include "indicesol.h" 34 #include "temps.h" 31 35 #include "control.h" 32 #include "temps.h"33 36 c====================================================================== 34 37 … … 50 53 real pplay(nlon,nlev) ! pression pour le mileu de chaque couche (en Pa) 51 54 real presnivs(klev) ! pressions approximat. des milieux couches ( en PA) 52 real znivsig(klev) ! niveaux sigma53 55 real paire(klon) 54 56 real pphis(klon) 55 57 logical debutphy ! le flag de l'initialisation de la physique 58 logical lafin ! le flag de la fin de la physique 59 56 60 integer ll 57 61 c … … 92 96 real ftsol(nlon,nbsrf) ! Temperature du sol (surf)(Kelvin) 93 97 real pctsrf(nlon,nbsrf) ! Pourcentage de sol f(nature du sol) 94 98 c abder 99 real pftsol1(nlon),pftsol2(nlon),pftsol3(nlon),pftsol4(nlon) 100 real ppsrf1(nlon),ppsrf2(nlon),ppsrf3(nlon),ppsrf4(nlon) 101 c fin 95 102 cAA ---------------------------- 96 103 cAA VARIABLES LOCALES TRACEURS … … 133 140 INTEGER nid_tra 134 141 SAVE nid_tra 135 INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev) 142 c REAL x(klon,klev,nbtr+2) ! traceurs 143 INTEGER ndex(1) 136 144 REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev) 137 145 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) … … 161 169 c 162 170 c--modif convection tiedtke 163 INTEGER i, k, it 164 171 INTEGER i, k, it,itap 172 save itap 165 173 REAL delp(klon,klev) 166 174 c--end modif … … 208 216 c print*,'DANS PHYTRAC debutphy=',debutphy 209 217 210 ecrit_tra = NINT(86400./pdtphys *ecritphy)211 zsto = pdtphys212 zout = pdtphys * FLOAT(ecrit_tra)213 218 if (debutphy) then 219 220 print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra 221 ecrit_tra = NINT(86400./pdtphys/2.) ! tous les 12H 222 c ecrit_tra = NINT(86400./pdtphys) ! tous les 24H 214 223 215 224 if(nbtr.lt.nqmax) then … … 223 232 PRINT*, 'La frequence de sortie traceurs est ', ecrit_tra 224 233 itra=0 234 itap=0 225 235 C 226 236 CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) … … 239 249 . 1,iim,1,jjm+1, 0, zjulian, pdtphys, 240 250 . nhori, nid_tra) 241 call histvert(nid_tra, 'sig_s', 'Niveaux sigma','-', 242 . klev, znivsig, nvert) 243 C 244 C CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb", 245 C . klev, presnivs, nvert) 251 CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb", 252 . klev, presnivs, nvert) 253 zsto = pdtphys 254 zout = pdtphys * FLOAT(ecrit_tra) 246 255 c 247 256 CALL histdef(nid_tra, "phis", "Surface geop. height", "-", … … 252 261 . iim,jjm+1,nhori, 1,1,1, -99, 32, 253 262 . "once", zsto,zout) 263 264 goto 666 265 CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-", 266 . iim,jjm+1,nhori, 1,1,1, -99, 32, 267 . "inst(X)", zsto,zout) 268 269 CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-", 270 . iim,jjm+1,nhori, 1,1,1, -99, 32, 271 . "inst(X)", zsto,zout) 272 CALL histdef(nid_tra, "psrf1", "nature sol", "-", 273 . iim,jjm+1,nhori, 1,1,1, -99, 32, 274 . "inst(X)", zsto,zout) 275 CALL histdef(nid_tra, "psrf2", "nature sol", "-", 276 . iim,jjm+1,nhori, 1,1,1, -99, 32, 277 . "inst(X)", zsto,zout) 278 CALL histdef(nid_tra, "psrf3", "nature sol", "-", 279 . iim,jjm+1,nhori, 1,1,1, -99, 32, 280 . "inst(X)", zsto,zout) 281 CALL histdef(nid_tra, "psrf4", "nature sol", "-", 282 . iim,jjm+1,nhori, 1,1,1, -99, 32, 283 . "inst(X)", zsto,zout) 284 CALL histdef(nid_tra, "ftsol1", "temper sol", "-", 285 . iim,jjm+1,nhori, 1,1,1, -99, 32, 286 . "inst(X)", zsto,zout) 287 CALL histdef(nid_tra, "ftsol2", "temper sol", "-", 288 . iim,jjm+1,nhori, 1,1,1, -99, 32, 289 . "inst(X)", zsto,zout) 290 CALL histdef(nid_tra, "ftsol3", "temper sol", "-", 291 . iim,jjm+1,nhori, 1,1,1, -99, 32, 292 . "inst", zsto,zout) 293 CALL histdef(nid_tra, "ftsol4", "temper sol", "-", 294 . iim,jjm+1,nhori, 1,1,1, -99, 32, 295 . "inst(X)", zsto,zout) 296 CALL histdef(nid_tra, "pplay", "flux u mont","-", 297 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 298 . "inst(X)", zsto,zout) 299 CALL histdef(nid_tra, "t", "flux u mont","-", 300 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 301 . "inst(X)", zsto,zout) 302 CALL histdef(nid_tra, "mfu", "flux u mont","-", 303 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 304 . "ave(X)", zsto,zout) 305 CALL histdef(nid_tra, "mfd", "flux u decen","-", 306 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 307 . "ave(X)", zsto,zout) 308 CALL histdef(nid_tra, "en_u", "flux u mont","-", 309 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 310 . "ave(X)", zsto,zout) 311 CALL histdef(nid_tra, "en_d", "flux u mont","-", 312 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 313 . "ave(X)", zsto,zout) 314 CALL histdef(nid_tra, "de_u", "flux u mont","-", 315 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 316 . "ave(X)", zsto,zout) 317 CALL histdef(nid_tra, "de_d", "flux u mont","-", 318 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 319 . "ave(X)", zsto,zout) 320 CALL histdef(nid_tra, "coefh", "turbulent coef","-", 321 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 322 . "ave(X)", zsto,zout) 323 324 666 continue 254 325 c 255 326 DO it=1,nqmax … … 271 342 ENDDO 272 343 CALL histend(nid_tra) 344 ndex(1) = 0 345 c 346 i = NINT(zout/zsto) 347 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 348 CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex) 349 C 350 i = NINT(zout/zsto) 351 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 352 CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex) 273 353 274 354 c====================================================================== … … 284 364 enddo 285 365 END DO 366 367 open (99,file='starttrac',status='old', 368 . err=999,form='formatted') 369 read(99,*) (trs(i,1),i=1,klon) 370 999 close(99) 371 print*, 'apres starttrac' 372 286 373 c Initialisation de la fraction d'aerosols lessivee 287 374 c … … 317 404 inirnpb=.false. 318 405 endif 406 if(nqmax.gt.2) aerosol(3)=.true. 407 408 409 c abder 410 goto 777 411 do i=1,nlon 412 pftsol1(i) = ftsol(i,1) 413 pftsol2(i) = ftsol(i,2) 414 pftsol3(i) = ftsol(i,3) 415 pftsol4(i) = ftsol(i,4) 416 417 ppsrf1(i) = pctsrf(i,1) 418 ppsrf2(i) = pctsrf(i,2) 419 ppsrf3(i) = pctsrf(i,3) 420 ppsrf4(i) = pctsrf(i,4) 421 422 enddo 423 ndex(1)=0 424 itap=itap+1 425 CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d) 426 CALL histwrite(nid_tra,"pyu1",itap,zx_tmp_2d, 427 s iim*(jjm+1),ndex) 428 429 CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d) 430 CALL histwrite(nid_tra,"pyv1",itap,zx_tmp_2d, 431 s iim*(jjm+1),ndex) 432 433 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d) 434 CALL histwrite(nid_tra,"ftsol1",itap,zx_tmp_2d, 435 s iim*(jjm+1),ndex) 436 437 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d) 438 CALL histwrite(nid_tra,"ftsol2",itap,zx_tmp_2d, 439 s iim*(jjm+1),ndex) 440 441 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d) 442 CALL histwrite(nid_tra,"ftsol3",itap,zx_tmp_2d, 443 s iim*(jjm+1),ndex) 444 445 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d) 446 CALL histwrite(nid_tra,"ftsol4",itap,zx_tmp_2d, 447 s iim*(jjm+1),ndex) 448 449 CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d) 450 CALL histwrite(nid_tra,"psrf1",itap,zx_tmp_2d, 451 s iim*(jjm+1),ndex) 452 453 CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d) 454 CALL histwrite(nid_tra,"psrf2",itap,zx_tmp_2d, 455 s iim*(jjm+1),ndex) 456 457 CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d) 458 CALL histwrite(nid_tra,"psrf3",itap,zx_tmp_2d, 459 s iim*(jjm+1),ndex) 460 461 CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf4,zx_tmp_2d) 462 CALL histwrite(nid_tra,"psrf4",itap,zx_tmp_2d, 463 s iim*(jjm+1),ndex) 464 777 continue 319 465 c====================================================================== 320 466 c Calcul de l'effet de la convection 321 467 c====================================================================== 468 print*,'Avant convection' 469 do it=1,nqmax 470 WRITE(itn,'(i1)') it 471 c call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn) 472 enddo 322 473 323 474 if (convection) then 324 475 325 cprint*,'Pas de temps dans phytrac : ',pdtphys476 print*,'Pas de temps dans phytrac : ',pdtphys 326 477 DO it=1, nqmax 327 478 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, … … 332 483 ENDDO 333 484 ENDDO 334 WRITE(itn,'(i1)') it335 CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)336 ENDDO 337 c print*,'apres nflxtr'485 c WRITE(itn,'(i1)') it 486 c CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn) 487 ENDDO 488 c print*,'apres nflxtr' 338 489 339 490 340 491 endif ! convection 492 c print*,'Apres convection' 493 c do it=1,nqmax 494 c WRITE(itn,'(i1)') it 495 c call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn) 496 c enddo 341 497 342 498 c====================================================================== 343 499 c Calcul de l'effet de la couche limite 344 500 c====================================================================== 345 346 c print*,'avant couchelimite' 501 c print *,'Avant couchelimite' 502 c do it=1,nqmax 503 c WRITE(itn,'(i1)') it 504 c call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL '//itn) 505 c enddo 506 347 507 if (couchelimite) then 348 508 … … 403 563 endif ! couche limite 404 564 405 c print*,'apres couchelimite' 565 c print*,'Apres couchelimite' 566 c do it=1,nqmax 567 c WRITE(itn,'(i1)') it 568 c call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL '//itn) 569 c enddo 406 570 407 571 c====================================================================== … … 432 596 c====================================================================== 433 597 598 print*,'LESSIVAGE =',lessivage 434 599 IF (lessivage) THEN 435 600 … … 464 629 c Mise a jour due a l'impaction et a la nucleation 465 630 c 631 c call dump2d(iim,jjm-1,frac_impa(2:klon-1,10),'FRACIMPA') 632 c call dump2d(iim,jjm-1,frac_nucl(2:klon-1,10),'FRACNUCL') 633 c call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3') 466 634 DO it = 1, nqmax 635 c print*,'IT=',it,aerosol(it) 467 636 IF (aerosol(it)) THEN 637 c print*,'IT=',it,' On lessive' 468 638 DO k = 1, nlev 469 639 DO i = 1, klon 470 tr_seri(i,k,it) = tr_seri(i,k,it) *471 s ( frac_impa(i,k) + frac_nucl(i,k) - 1. )640 tr_seri(i,k,it)=tr_seri(i,k,it) 641 s *frac_impa(i,k)*frac_nucl(i,k) 472 642 ENDDO 473 643 ENDDO 474 644 ENDIF 475 645 ENDDO 646 c call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3B') 476 647 c 477 648 c Flux lessivage total … … 507 678 ENDDO 508 679 itra=itra+1 509 510 C 511 C Sorties IOIPSL 512 ndex2d = 0 513 ndex3d = 0 514 c 515 c write(*,*)'sorties ioipsl phytrac',zsto,zout 516 CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d) 517 CALL histwrite(nid_tra,"phis",itra,zx_tmp_2d,iim*(jjm+1),ndex2d) 518 C 519 CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d) 520 CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,iim*(jjm+1),ndex2d) 680 ndex(1) = 0 521 681 DO it=1,nqmax 522 682 IF (it.LE.99) THEN … … 525 685 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d) 526 686 CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d, 527 . iim*(jjm+1)*klev,ndex 3d)528 529 530 531 . iim*(jjm+1)*klev,ndex3d)532 687 . iim*(jjm+1)*klev,ndex) 688 c IF (lessivage) THEN 689 c CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d) 690 c CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d, 691 c . iim*(jjm+1)*klev,ndex) 692 c ENDIF 533 693 ELSE 534 694 PRINT*, "Trop de traceurs" … … 536 696 ENDIF 537 697 ENDDO 538 if (ok_sync) call histsync(nid_tra) 698 699 goto 888 700 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay,zx_tmp_3d) 701 CALL histwrite(nid_tra,"pplay",itra,zx_tmp_3d, 702 . iim*(jjm+1)*klev,ndex) 703 704 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri,zx_tmp_3d) 705 CALL histwrite(nid_tra,"t",itra,zx_tmp_3d, 706 . iim*(jjm+1)*klev,ndex) 707 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfu,zx_tmp_3d) 708 CALL histwrite(nid_tra,"mfu",itra,zx_tmp_3d, 709 . iim*(jjm+1)*klev,ndex) 710 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfd,zx_tmp_3d) 711 CALL histwrite(nid_tra,"mfd",itra,zx_tmp_3d, 712 . iim*(jjm+1)*klev,ndex) 713 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_u,zx_tmp_3d) 714 CALL histwrite(nid_tra,"en_u",itra,zx_tmp_3d, 715 . iim*(jjm+1)*klev,ndex) 716 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_d,zx_tmp_3d) 717 CALL histwrite(nid_tra,"en_d",itra,zx_tmp_3d, 718 . iim*(jjm+1)*klev,ndex) 719 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_d,zx_tmp_3d) 720 CALL histwrite(nid_tra,"de_d",itra,zx_tmp_3d, 721 . iim*(jjm+1)*klev,ndex) 722 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_u,zx_tmp_3d) 723 CALL histwrite(nid_tra,"de_u",itra,zx_tmp_3d, 724 . iim*(jjm+1)*klev,ndex) 725 CALL gr_fi_ecrit(klev,klon,iim,jjm+1,coefh,zx_tmp_3d) 726 CALL histwrite(nid_tra,"coefh",itra,zx_tmp_3d, 727 . iim*(jjm+1)*klev,ndex) 728 729 888 continue 730 731 c print*,'Sortie phytrac' 732 c do it=1,nqmax 733 c WRITE(itn,'(i1)') it 734 c call diagtracphy(tr_seri(:,:,it),paprs,'Fin Phys '//itn) 735 c enddo 736 737 if (lafin) then 738 print*, 'c est la fin de la physique' 739 open (99,file='restarttrac', form='formatted') 740 do i=1,klon 741 write(99,*) trs(i,1) 742 enddo 743 PRINT*, 'Ecriture du fichier restarttrac' 744 close(99) 745 else 746 print*, 'physique pas fini' 747 endif 748 539 749 540 750 RETURN
Note: See TracChangeset
for help on using the changeset viewer.
