Changeset 53 for LMDZ.3.3/trunk/libf


Ignore:
Timestamp:
Feb 18, 2000, 12:37:13 PM (25 years ago)
Author:
lmdzadmin
Message:

Correction sur le calendrier. LF

Location:
LMDZ.3.3/trunk/libf/phylmd
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r48 r53  
    5656#include "clesphys.h"
    5757#include "control.h"
     58#include "temps.h"
    5859c======================================================================
    5960      LOGICAL check ! Verifier la conservation du modele en eau
    … …  
    282283      REAL yv1(klon)            ! vents dans la premiere couche V
    283284      LOGICAL offline           ! Controle du stockage ds "physique"
    284       PARAMETER (offline=.FALSE.)
     285      PARAMETER (offline=.true.)
     286      INTEGER physid
    285287      REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
    286288      save pfrac_impa
    … …  
    671673      IF (ok_journe) THEN
    672674c
    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
    676677c
    677678         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
    … …  
    824825         ndex3d = 0
    825826c
    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 c
    830 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 c
    834827      ENDIF ! fin de test sur ok_journe
    835828c
    836829      IF (ok_mensuel) THEN
    837830c
    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
    841833c
    842834         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
    … …  
    11721164         ndex3d = 0
    11731165c
    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 C
    1178 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 c
    11821166      ENDIF ! fin de test sur ok_mensuel
    11831167c
    … …  
    11851169      IF (ok_instan) THEN
    11861170c
    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
    11901173c
    11911174         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
    … …  
    12531236         ndex2d = 0
    12541237         ndex3d = 0
    1255 c
    1256 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 c
    1260 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)
    12631238c
    12641239      ENDIF
    … …  
    19431918C la physique s'applique
    19441919C
    1945        write(*,*) 'Phytrac= '
    19461920      call phytrac (rnpb,
    19471921     I                   debut,
    … …  
    19551929     O                   tr_seri)
    19561930
    1957        write(*,*) 'OFFLINE= ', offline
    19581931      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,
    19621935     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    19631936     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)
    19651940
    19661941      ENDIF

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

    r2 r53  
    2828#include "indicesol.h"
    2929#include "control.h"
     30#include "temps.h"
    3031c======================================================================
    3132
    … …  
    130131      INTEGER nid_tra
    131132      SAVE nid_tra
    132       INTEGER ndex(1)
     133      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
    133134      REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
    134135      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
    … …  
    140141      INTEGER ecrit_tra
    141142      SAVE ecrit_tra   
     143      logical ok_sync
     144      parameter (ok_sync = .true.)
    142145C
    143146C nature du traceur
    … …  
    201204         modname='phytrac'
    202205
    203          print*,'DANS PHYTRAC debutphy=',debutphy
     206c        print*,'DANS PHYTRAC debutphy=',debutphy
    204207
    205208         ecrit_tra = NINT(86400./pdtphys *ecritphy)   
     209         zsto = pdtphys
     210         zout = pdtphys * FLOAT(ecrit_tra)
    206211         if (debutphy) then
    207212
    … …  
    217222         itra=0
    218223C         
    219          CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian)
    220          zjulian = zjulian + dayref
     224         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
     225         zjulian = zjulian + day_ini
    221226c
    222227         CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon)
    … …  
    237242C         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
    238243C     .                 klev, presnivs, nvert)
    239          zsto = pdtphys
    240          zout = pdtphys * FLOAT(ecrit_tra)
    241244c
    242245         CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
    … …  
    266269         ENDDO
    267270         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
    278272c======================================================================
    279273c   Initialisation de certaines variables pour le Rn et le Pb
    … …  
    282276c Initialisation du traceur dans le sol (couche limite radonique)
    283277c
    284          print*,'valeur de debut dans phytrac :',debutphy
     278c        print*,'valeur de debut dans phytrac :',debutphy
    285279         do it=1,nqmax
    286280            do i=1,klon
    … …  
    327321      if (convection) then
    328322
    329       print*,'Pas de temps dans phytrac : ',pdtphys
     323c     print*,'Pas de temps dans phytrac : ',pdtphys
    330324      DO it=1, nqmax
    331325      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    … …  
    339333      CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
    340334      ENDDO
    341       print*,'apres nflxtr'
     335c     print*,'apres nflxtr'
    342336
    343337
    … …  
    348342c======================================================================
    349343
    350       print*,'avant couchelimite'
     344c     print*,'avant couchelimite'
    351345      if (couchelimite) then
    352346
    … …  
    359353C maf modif pour tenir compte du cas rnpb + traceur
    360354      DO it=1, nqmax
    361       print *,'it',it,clsol(it)
     355c     print *,'it',it,clsol(it)
    362356      if (clsol(it)) then  ! couche limite avec quantite dans le sol calculee
    363357          CALL cltracrn(it, pdtphys, yu1, yv1,
    … …  
    407401      endif ! couche limite
    408402
    409       print*,'apres couchelimite'
     403c     print*,'apres couchelimite'
    410404
    411405c======================================================================
    … …  
    438432      IF (lessivage) THEN
    439433
    440       print*,'avant lessivage'
     434c     print*,'avant lessivage'
    441435
    442436       DO it = 1, nqmax
    … …  
    497491      ENDDO
    498492c
    499       print*,'apres lessivage'
     493c     print*,'apres lessivage'
    500494      ENDIF
    501495Cc
    … …  
    511505      ENDDO
    512506      itra=itra+1
    513       ndex(1) = 0
     507
     508C
     509C Sorties IOIPSL
     510      ndex2d = 0
     511      ndex3d = 0
     512c
     513c     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)
     516C
     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)
    514519      DO it=1,nqmax
    515520      IF (it.LE.99) THEN
    … …  
    518523       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
    519524       CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d,
    520      .                                   iim*(jjm+1)*klev,ndex)
     525     .                                   iim*(jjm+1)*klev,ndex3d)
    521526       IF (lessivage) THEN
    522527       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
    523528       CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
    524      .                                   iim*(jjm+1)*klev,ndex)
     529     .                                   iim*(jjm+1)*klev,ndex3d)
    525530      ENDIF
    526531      ELSE
    … …  
    529534      ENDIF
    530535      ENDDO
     536      if (ok_sync) call histsync(nid_tra)
    531537
    532538      RETURN
Note: See TracChangeset for help on using the changeset viewer.