Ignore:
Timestamp:
Apr 13, 2001, 12:44:53 PM (23 years ago)
Author:
lmdz
Message:

Debogage du guidage et de la version debranchee et abandon de la version
debranchee non-netcdf FH/MAF
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/trunk/libf/phylmd/phytrac.F

    r199 r204  
    3030#include "dimphy.h"
    3131#include "indicesol.h"
    32 #include "control.h"
    33 #include "temps.h"
    3432c======================================================================
    3533
    … …  
    5149      real pplay(nlon,nlev)  ! pression pour le mileu de chaque couche (en Pa)
    5250      real presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
    53       real znivsig(klev) ! niveaux sigma
    5451      real paire(klon)
    5552      real pphis(klon)
    … …  
    9592      real ftsol(nlon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
    9693      real pctsrf(nlon,nbsrf) ! Pourcentage de sol f(nature du sol)
    97 
     94c abder
     95      real pftsol1(nlon),pftsol2(nlon),pftsol3(nlon),pftsol4(nlon)
     96      real ppsrf1(nlon),ppsrf2(nlon),ppsrf3(nlon),ppsrf4(nlon)
     97c fin
    9898cAA ----------------------------
    9999cAA  VARIABLES LOCALES TRACEURS
    … …  
    136136      INTEGER nid_tra
    137137      SAVE nid_tra
    138       INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
     138c     REAL x(klon,klev,nbtr+2) ! traceurs
     139      INTEGER ndex(1)
    139140      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
    140141      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
    … …  
    164165c
    165166c--modif convection tiedtke
    166       INTEGER i, k, it
    167 
     167      INTEGER i, k, it,itap
     168        save itap
    168169      REAL delp(klon,klev)
    169170c--end modif
    … …  
    211212c        print*,'DANS PHYTRAC debutphy=',debutphy
    212213
    213          ecrit_tra = NINT(86400./pdtphys *ecritphy)   
    214          zsto = pdtphys
    215          zout = pdtphys * FLOAT(ecrit_tra)
    216214         if (debutphy) then
     215
     216          print*,'dans phytrac ',pdtphys,ecritphy,ecrit_tra
     217          ecrit_tra = NINT(86400./pdtphys/2.) ! tous les 12H
     218c         ecrit_tra = NINT(86400./pdtphys) ! tous les 24H
    217219
    218220         if(nbtr.lt.nqmax) then
    … …  
    226228         PRINT*, 'La frequence de sortie traceurs est  ', ecrit_tra
    227229         itra=0
     230         itap=0
    228231C         
    229232         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
    … …  
    242245     .                 1,iim,1,jjm+1, 0, zjulian, pdtphys,
    243246     .                 nhori, nid_tra)
    244          call histvert(nid_tra, 'sig_s', 'Niveaux sigma','-',
    245      .              klev, znivsig, nvert)
    246 C
    247 C         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
    248 C     .                 klev, presnivs, nvert)
     247         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
     248     .                 klev, presnivs, nvert)
     249         zsto = pdtphys
     250         zout = pdtphys * FLOAT(ecrit_tra)
    249251c
    250252         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
    … …  
    255257     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
    256258     .                "once",  zsto,zout)
     259
     260        goto 666
     261         CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",
     262     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     263     .                "inst(X)",  zsto,zout)
     264
     265         CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-",
     266     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     267     .                "inst(X)",  zsto,zout)
     268         CALL histdef(nid_tra, "psrf1", "nature sol", "-",
     269     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     270     .                "inst(X)",  zsto,zout)
     271         CALL histdef(nid_tra, "psrf2", "nature sol", "-",
     272     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     273     .                "inst(X)",  zsto,zout)
     274         CALL histdef(nid_tra, "psrf3", "nature sol", "-",
     275     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     276     .                "inst(X)",  zsto,zout)
     277         CALL histdef(nid_tra, "psrf4", "nature sol", "-",
     278     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     279     .                "inst(X)",  zsto,zout)
     280         CALL histdef(nid_tra, "ftsol1", "temper sol", "-",
     281     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     282     .                "inst(X)",  zsto,zout)
     283         CALL histdef(nid_tra, "ftsol2", "temper sol", "-",
     284     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     285     .                "inst(X)",  zsto,zout)
     286         CALL histdef(nid_tra, "ftsol3", "temper sol", "-",
     287     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     288     .                "inst",  zsto,zout)
     289         CALL histdef(nid_tra, "ftsol4", "temper sol", "-",
     290     .                iim,jjm+1,nhori, 1,1,1, -99, 32,
     291     .                "inst(X)",  zsto,zout)
     292         CALL histdef(nid_tra, "pplay", "flux u mont","-",
     293     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     294     .                "inst(X)", zsto,zout)
     295         CALL histdef(nid_tra, "t", "flux u mont","-",
     296     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     297     .                "inst(X)", zsto,zout)
     298         CALL histdef(nid_tra, "mfu", "flux u mont","-",
     299     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     300     .                "ave(X)", zsto,zout)
     301         CALL histdef(nid_tra, "mfd", "flux u decen","-",
     302     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     303     .                "ave(X)", zsto,zout)
     304         CALL histdef(nid_tra, "en_u", "flux u mont","-",
     305     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     306     .                "ave(X)", zsto,zout)
     307         CALL histdef(nid_tra, "en_d", "flux u mont","-",
     308     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     309     .                "ave(X)", zsto,zout)
     310         CALL histdef(nid_tra, "de_u", "flux u mont","-",
     311     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     312     .                "ave(X)", zsto,zout)
     313         CALL histdef(nid_tra, "de_d", "flux u mont","-",
     314     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     315     .                "ave(X)", zsto,zout)
     316         CALL histdef(nid_tra, "coefh", "turbulent coef","-",
     317     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
     318     .                "ave(X)", zsto,zout)
     319
     320666     continue
    257321c
    258322         DO it=1,nqmax
    … …  
    274338         ENDDO
    275339         CALL histend(nid_tra)
     340         ndex(1) = 0
     341c
     342         i = NINT(zout/zsto)
     343         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
     344         CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
     345C
     346         i = NINT(zout/zsto)
     347         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
     348         CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
    276349
    277350c======================================================================
    … …  
    327400         inirnpb=.false.
    328401      endif
     402      if(nqmax.gt.2) aerosol(3)=.true.
     403
     404
     405c  abder
     406        goto 777
     407            do i=1,nlon
     408               pftsol1(i) = ftsol(i,1)
     409               pftsol2(i) = ftsol(i,2)
     410               pftsol3(i) = ftsol(i,3)
     411               pftsol4(i) = ftsol(i,4)
     412
     413               ppsrf1(i) = pctsrf(i,1)
     414               ppsrf2(i) = pctsrf(i,2)
     415               ppsrf3(i) = pctsrf(i,3)
     416               ppsrf4(i) = pctsrf(i,4)
     417
     418            enddo
     419         ndex(1)=0
     420         itap=itap+1
     421         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yu1,zx_tmp_2d)
     422         CALL histwrite(nid_tra,"pyu1",itap,zx_tmp_2d,
     423     s                                  iim*(jjm+1),ndex)
     424         
     425         CALL gr_fi_ecrit(1,klon,iim,jjm+1,yv1,zx_tmp_2d)
     426         CALL histwrite(nid_tra,"pyv1",itap,zx_tmp_2d,
     427     s                                  iim*(jjm+1),ndex)
     428
     429         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol1,zx_tmp_2d)
     430         CALL histwrite(nid_tra,"ftsol1",itap,zx_tmp_2d,
     431     s                                       iim*(jjm+1),ndex)
     432
     433         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol2,zx_tmp_2d)
     434         CALL histwrite(nid_tra,"ftsol2",itap,zx_tmp_2d,
     435     s                                       iim*(jjm+1),ndex)
     436
     437         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol3,zx_tmp_2d)
     438         CALL histwrite(nid_tra,"ftsol3",itap,zx_tmp_2d,
     439     s                                      iim*(jjm+1),ndex)
     440
     441         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pftsol4,zx_tmp_2d)
     442         CALL histwrite(nid_tra,"ftsol4",itap,zx_tmp_2d,
     443     s                                      iim*(jjm+1),ndex)
     444
     445         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf1,zx_tmp_2d)
     446         CALL histwrite(nid_tra,"psrf1",itap,zx_tmp_2d,
     447     s                                     iim*(jjm+1),ndex)
     448
     449         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf2,zx_tmp_2d)
     450         CALL histwrite(nid_tra,"psrf2",itap,zx_tmp_2d,
     451     s                                     iim*(jjm+1),ndex)
     452
     453         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf3,zx_tmp_2d)
     454         CALL histwrite(nid_tra,"psrf3",itap,zx_tmp_2d,
     455     s                                     iim*(jjm+1),ndex)
     456
     457         CALL gr_fi_ecrit(1,klon,iim,jjm+1,ppsrf4,zx_tmp_2d)
     458         CALL histwrite(nid_tra,"psrf4",itap,zx_tmp_2d,
     459     s                                     iim*(jjm+1),ndex)
     460777     continue
    329461c======================================================================
    330462c   Calcul de l'effet de la convection
    331463c======================================================================
     464        print*,'Avant convection'
     465      do it=1,nqmax
     466         WRITE(itn,'(i1)') it
     467c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
     468      enddo
    332469
    333470      if (convection) then
    334471
    335 c     print*,'Pas de temps dans phytrac : ',pdtphys
     472      print*,'Pas de temps dans phytrac : ',pdtphys
    336473      DO it=1, nqmax
    337474      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    … …  
    342479      ENDDO
    343480      ENDDO
    344       WRITE(itn,'(i1)') it
    345       CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
    346       ENDDO
    347 c     print*,'apres nflxtr'
     481c      WRITE(itn,'(i1)') it
     482c      CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
     483      ENDDO
     484c      print*,'apres nflxtr'
    348485
    349486
    350487      endif ! convection
     488c        print*,'Apres convection'
     489c      do it=1,nqmax
     490c         WRITE(itn,'(i1)') it
     491c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
     492c      enddo
    351493
    352494c======================================================================
    353495c   Calcul de l'effet de la couche limite
    354496c======================================================================
    355 
    356 c     print*,'avant couchelimite'
     497c       print *,'Avant couchelimite'
     498c      do it=1,nqmax
     499c         WRITE(itn,'(i1)') it
     500c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
     501c      enddo
     502
    357503      if (couchelimite) then
    358504
    … …  
    413559      endif ! couche limite
    414560
    415 c     print*,'apres couchelimite'
     561c      print*,'Apres couchelimite'
     562c      do it=1,nqmax
     563c         WRITE(itn,'(i1)') it
     564c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
     565c      enddo
    416566
    417567c======================================================================
    … …  
    442592c======================================================================
    443593
     594      print*,'LESSIVAGE =',lessivage
    444595      IF (lessivage) THEN
    445596
    … …  
    474625c Mise a jour due a l'impaction et a la nucleation
    475626c
     627c      call dump2d(iim,jjm-1,frac_impa(2:klon-1,10),'FRACIMPA')
     628c      call dump2d(iim,jjm-1,frac_nucl(2:klon-1,10),'FRACNUCL')
     629c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3')
    476630       DO it = 1, nqmax
     631c         print*,'IT=',it,aerosol(it)
    477632         IF (aerosol(it)) THEN
     633c           print*,'IT=',it,' On lessive'
    478634           DO k = 1, nlev
    479635              DO i = 1, klon
    480                tr_seri(i,k,it) = tr_seri(i,k,it) *
    481      s              ( frac_impa(i,k) + frac_nucl(i,k) - 1. )   
     636               tr_seri(i,k,it)=tr_seri(i,k,it)
     637     s         *frac_impa(i,k)*frac_nucl(i,k)
    482638              ENDDO
    483639           ENDDO
    484640         ENDIF
    485641       ENDDO
     642c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3B')
    486643c
    487644c Flux lessivage total
    … …  
    517674      ENDDO
    518675      itra=itra+1
    519 
    520 C
    521 C Sorties IOIPSL
    522       ndex2d = 0
    523       ndex3d = 0
    524 c
    525 c     write(*,*)'sorties ioipsl phytrac',zsto,zout
    526       CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
    527       CALL histwrite(nid_tra,"phis",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
    528 C
    529       CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
    530       CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
     676      ndex(1) = 0
    531677      DO it=1,nqmax
    532678      IF (it.LE.99) THEN
    … …  
    535681       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
    536682       CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d,
    537      .                                   iim*(jjm+1)*klev,ndex3d)
    538        IF (lessivage) THEN
    539        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
    540        CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
    541      .                                   iim*(jjm+1)*klev,ndex3d)
    542       ENDIF
     683     .                                   iim*(jjm+1)*klev,ndex)
     684c      IF (lessivage) THEN
     685c      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
     686c      CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
     687c    .                                   iim*(jjm+1)*klev,ndex)
     688c     ENDIF
    543689      ELSE
    544690         PRINT*, "Trop de traceurs"
    … …  
    546692      ENDIF
    547693      ENDDO
    548       if (ok_sync) call histsync(nid_tra)
     694
     695        goto 888
     696        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pplay,zx_tmp_3d)
     697        CALL histwrite(nid_tra,"pplay",itra,zx_tmp_3d,
     698     .                  iim*(jjm+1)*klev,ndex)
     699
     700        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,t_seri,zx_tmp_3d)
     701        CALL histwrite(nid_tra,"t",itra,zx_tmp_3d,
     702     .                  iim*(jjm+1)*klev,ndex)
     703        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfu,zx_tmp_3d)
     704        CALL histwrite(nid_tra,"mfu",itra,zx_tmp_3d,
     705     .                  iim*(jjm+1)*klev,ndex)
     706        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pmfd,zx_tmp_3d)
     707        CALL histwrite(nid_tra,"mfd",itra,zx_tmp_3d,
     708     .                  iim*(jjm+1)*klev,ndex)
     709        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_u,zx_tmp_3d)
     710        CALL histwrite(nid_tra,"en_u",itra,zx_tmp_3d,
     711     .                  iim*(jjm+1)*klev,ndex)
     712        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pen_d,zx_tmp_3d)
     713        CALL histwrite(nid_tra,"en_d",itra,zx_tmp_3d,
     714     .                  iim*(jjm+1)*klev,ndex)
     715        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_d,zx_tmp_3d)
     716        CALL histwrite(nid_tra,"de_d",itra,zx_tmp_3d,
     717     .                  iim*(jjm+1)*klev,ndex)
     718        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,pde_u,zx_tmp_3d)
     719        CALL histwrite(nid_tra,"de_u",itra,zx_tmp_3d,
     720     .                  iim*(jjm+1)*klev,ndex)
     721        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,coefh,zx_tmp_3d)
     722        CALL histwrite(nid_tra,"coefh",itra,zx_tmp_3d,
     723     .                  iim*(jjm+1)*klev,ndex)
     724
     725888     continue
     726
     727c       print*,'Sortie phytrac'
     728c      do it=1,nqmax
     729c         WRITE(itn,'(i1)') it
     730c        call diagtracphy(tr_seri(:,:,it),paprs,'Fin Phys  '//itn)
     731c      enddo
    549732
    550733      if (lafin) then
Note: See TracChangeset for help on using the changeset viewer.