Changeset 204 for LMDZ.3.3/trunk


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

Location:
LMDZ.3.3/trunk/libf
Files:
5 deleted
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/trunk/libf/dyn3d/grilles_gcm_netcdf.F

    r198 r204  
     1c
    12c $Header
     3c
     4
    25      PROGRAM create_fausse_var
    36C
    … …  
    912#include "comconst.h"
    1013#include "comgeom.h"
     14#include "comvert.h"
     15
     16      real temp(iim+1,jjm+1)
    1117#include "netcdf.inc"
    1218
    … …  
    1925        integer*4 out_latudim,out_latvdim,out_dim(3)
    2026
    21 c   champs a faire disparaitre
    22         real ucov(ijp1llm),vcov(ijmllm),teta(ijp1llm)
    23         real masse(ijp1llm),ps(ip1jmp1),phis(ip1jmp1)
    24         real q(ijp1llm*nqmx)
    25         real time_0
    26 
    27         real clesphy0(20),pa,preff
     27      INTEGER         longcles
     28      PARAMETER     ( longcles = 20 )
     29      REAL  clesphy0( longcles )
     30
     31      integer start(4),count(4)
    2832
    2933        integer status,i,j
    … …  
    3135        real rlonudeg(iip1),rlonvdeg(iip1)
    3236
     37      real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
     38      real acoslat,dxkm,dykm,resol(iip1,jjp1)
     39
     40#include "serre.h"
     41#include "fxyprim.h"
     42
     43      print*,'OK0'
    3344
    3445      rad = 6400000
    … …  
    4253      pa= 50000.
    4354
    44 c     CALL dynetat0("start.nc",nqmx,vcov,ucov,
    45 c    .              teta,q,masse,ps,phis, time_0)
    46 
    47 
    4855      open(99,file='run.def',status='old',form='formatted')
    49       CALL defrun_new( 99, .TRUE. ,clesphy0)
     56      CALL defrun_new( 99, .TRUE.,clesphy0 )
    5057      close(99)
    5158      CALL iniconst
    52       print*,'inigeom pas OK'
    5359      CALL inigeom
    54       print*,'inigeom OK'
    55 
     60
     61
     62      print*,'OK1'
    5663      do j=1,jjp1
    5764         rlatudeg(j)=rlatu(j)*180./pi
    … …  
    6673      enddo
    6774
    68       print*,'  2 ----- OUVERTURE DE LA SORTIE NETCDF'
     75
     76      print*,'OK2'
     77c  2 ----- OUVERTURE DE LA SORTIE NETCDF
    6978c ---------------------------------------------------
    7079c CREATION OUTPUT
    … …  
    7887        status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
    7988
     89
     90      print*,'OK3'
    8091c   Longitudes en u
    8192        print *,'OUTID: ',ncid_out
    … …  
    138149     %  16,'Grille aux point v')
    139150
    140 
     151c   ecriture de la grille u
     152        out_dim(1)=out_lonvdim
     153        out_dim(2)=out_latudim
     154        status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim,
     155     %  out_varid)
     156        call handle_err(status)
     157        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
     158     %  6,'Kelvin')
     159        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
     160     %  16,'Grille aux point u')
     161
     162
     163      print*,'OK4'
    141164        status=NF_ENDDEF(ncid_out)
    142         print*,' 5) ----- FERMETURE DES FICHIERS NETCDF-'
     165c 5) ----- FERMETURE DES FICHIERS NETCDF------------------
    143166c --------------------------------------------------------
    144167c 3-b- Ecriture de la grille pour la sortie
    … …  
    150173        status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
    151174
     175        start(1)=1
     176        start(2)=1
     177        start(3)=1
     178        start(4)=1
     179
     180        count(1)=iim+1
     181        count(2)=jjm+1
     182        count(3)=1
     183        count(4)=1
     184
     185        do j=1,jjm+1
     186           do i=1,iim+1
     187              temp(i,j)=mod(i,2)+mod(j,2)
     188           enddo
     189        enddo
     190
     191        status=NF_PUT_VARA_REAL(ncid_out,out_varid,start,
     192     s  count,temp)
    152193
    153194c fermeture du fichier netcdf
    … …  
    155196        write(*,*) 'Fermeture: ',fich_out
    156197
     198
     199      print*,'OK5'
     200c   Ecriture grads
     201      open (20,file='grille.dat',form='unformatted',access='direct'
     202     s      ,recl=4*ip1jmp1)
     203      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
     204      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
     205      do j=2,jjm
     206         dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
     207c        dlat2(j)=180.*fyprim(float(j))/pi
     208      enddo
     209      do i=2,iip1
     210         dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
     211c        dlon2(i)=180.*fxprim(float(i))/pi
     212      enddo
     213      do j=2,jjm
     214         dykm=(rlatv(j)-rlatv(j-1))*6400.
     215         acoslat=6400.*cos(rlatu(j))
     216         do i=2,iip1
     217            dxkm=acoslat*(rlonu(i)-rlonu(i-1))
     218            resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm)
     219         enddo
     220         resol(1,j)=resol(iip1,j)
     221      enddo
     222      write(20,rec=3) resol
     223      dlon1(1)=dlon1(iip1)
     224      dlon2(1)=dlon2(iip1)
     225      write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1)
     226      write(20,rec=5) ((dlon2(i),i=1,iip1),j=1,jjp1)
     227      write(20,rec=6) ((dlat1(j),i=1,iip1),j=1,jjp1)
     228      write(20,rec=7) ((dlat2(j),i=1,iip1),j=1,jjp1)
     229       
     230      open (21,file='grille.ctl',form='formatted')
     231
     232c   WARNING! on reecrase le fichier .ctl a chaque ecriture
     233      write(21,'(a5,1x,a40)')
     234     &       'DSET ','^grille.dat'
     235
     236      write(21,'(a12)') 'UNDEF 1.0E30'
     237      write(21,'(a5,1x,a40)') 'TITLE ','grille'
     238      call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF')
     239      call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF')
     240      call formcoord(21,1,0.,1.,.false.,'ZDEF')
     241      write(21,'(a4,i10,a30)')
     242     &       'TDEF ',1,' LINEAR 23OCT1994 3hr '
     243      write(21,'(a4,2x,i5)') 'VARS',7
     244      write(21,'(a18)') 'grille 0 99 grille'
     245      write(21,'(a18)') 'gril   0 99 gril  '
     246      write(21,'(a29)') 'resol   0 99 resolution (km)  '
     247      write(21,'(a18)') 'dlon1  0 99 dlon1 '
     248      write(21,'(a18)') 'dlon2  0 99 dlon2 '
     249      write(21,'(a18)') 'dlat1  0 99 dlat1 '
     250      write(21,'(a18)') 'dlat2  0 99 dlat2 '
     251      write(21,'(a7)') 'ENDVARS'
     252
     253
     254
     255
     256
     257      print*,'OK6'
    157258        end
    158259
    … …  
    161262        subroutine handle_err(status)
    162263#include "netcdf.inc"
     264
     265
    163266        integer status
    164267        print *,'handle code err: ',NF_NOERR

  • LMDZ.3.3/trunk/libf/dyn3d/nudge.F

    r198 r204  
    9999     s   ,'1: en-ligne, 0: hors-ligne (x=x_rea), -1: climat (x=x_gcm)'
    100100cnec         read(*,*) online
    101           online=-1
    102          print*,'Entrer les constantes de temps de rappel en jours'
    103          print*,'alphaT,alphau,alphav,alphaP'
     101cnec      online=-1
     102cnec     print*,'Entrer les constantes de temps de rappel en jours'
    104103cnec         read(*,*)alphaT
    105104cnec         read(*,*)alphau
    … …  
    110109             alphav=0.1
    111110             alphaP=1.e10
     111         print*,'alphaT,alphau,alphav,alphaP'
     112     s          ,alphaT,alphau,alphav,alphaP
    112113         if(online.eq.-1) return
    113114         print*,'alpha rappel pour T, u, v, P ',
    … …  
    142143c   Lecture du premier etat des reanalyses.
    143144         call read_reanalyse(1
    144      s   ,ucovrea2,vcovrea2,tetarea2,masserea2,psrea2,1)
     145     s   ,ucovrea2,vcovrea2,tetarea2,masserea2,ps,1)
    145146
    146147c-----------------------------------------------------------------------
    … …  
    171172           CALL SCOPY( ijp1llm,ucovrea2, 1, ucovrea1 , 1 )
    172173           CALL SCOPY( ijp1llm,tetarea2,1,tetarea1   , 1 )
    173            CALL SCOPY( ijp1llm,masserea2,1,masserea1   , 1 )
    174            CALL SCOPY( ip1jmp1,psrea2, 1,  psrea1, 1 )
     174c          CALL SCOPY( ijp1llm,masserea2,1,masserea1   , 1 )
     175c          CALL SCOPY( ip1jmp1,psrea2, 1,  psrea1, 1 )
    175176
    176177          print*,'LECTURE REANALYSES, pas ',step_rea
    … …  
    179180           itau_test=itau
    180181           call read_reanalyse(step_rea
    181      s     ,ucovrea2,vcovrea2,tetarea2,masserea2,psrea2,1)
     182     s     ,ucovrea2,vcovrea2,tetarea2,masserea2,ps,1)
    182183        endif
    183184      else
    … …  
    205206            a=(1.-tau)*tetarea1(ij,l)+tau*tetarea2(ij,l)
    206207            teta(ij,l)=alphaT*teta(ij,l)+(1-alphaT)*a
    207             a=(1.-tau)*masserea1(ij,l)+tau*masserea2(ij,l)
    208             masse(ij,l)=alphaP*masse(ij,l)+(1-alphaP)*a
     208c           a=(1.-tau)*masserea1(ij,l)+tau*masserea2(ij,l)
     209c           masse(ij,l)=alphaP*masse(ij,l)+(1-alphaP)*a
    209210         enddo
    210211         do ij=1,ip1jm

  • LMDZ.3.3/trunk/libf/dyn3d/offlinenc.F

    r187 r204  
     1c
     2c $Header
     3c
    14      PROGRAM offlinenc
    25      USE ioipsl
    … …  
    6669        integer iiinj
    6770      integer jour0,isplit,nsplit_dyn,nsplit_phy,nsplit
    68       logical debut,lectstart,rnpb
     71      logical debut,lectstart,rnpb,lafin
    6972
    7073      EXTERNAL inidissip,iniconst,inifilr
    … …  
    190193     .              teta,q,masse,ps,phis, time_0)
    191194         print*,'Lecture du start'
     195c  On zappe le radon et le plomb.
     196         q(:,:,:,1)=q(:,:,:,3)
     197         q(:,:,:,2)=q(:,:,:,4)
     198c Initialisation d'un traceur ` 1 pour tester l'impact du lessivage.
     199         q(:,:,:,3)=1.
    192200      else
    193201         day_ini=0
    … …  
    203211C      print*,'av iniconst'
    204212c   lecture du jour de demarrage
    205 c    premiere initialisation, eventuellement bidon
    206       CALL iniconst
     213c    premiere cnitialisation, eventuellement bidon
     214      cALL iniconst
    207215      CALL inigeom
    208216C
    209       print*,'ENTREE DANS redecoupenc ou lectfluxnc0
     217      print*,'ENTREE DANS redecoupenc ou lectfluxnc
    210218     s        pour irec=0'
    211219
    … …  
    219227     s     frac_impa,frac_nucl,phis)
    220228      else
    221          call lectfluxnc0(0,masse,pbaru,pbarv,w,teta,phi,
     229         call lectfluxnc(0,masse,pbaru,pbarv,w,teta,phi,
    222230     s     nrec,avant,airefi,pphis,
    223231     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
    … …  
    373381     s     frac_impa,frac_nucl,phis)
    374382      else
    375          call lectfluxnc0(irec,masse,pbaru,pbarv,w,teta,phi,
     383         call lectfluxnc(irec,masse,pbaru,pbarv,w,teta,phi,
    376384     s     nrec,avant,airefi,pphis,
    377385     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
    … …  
    380388      endif
    381389
     390
     391      print*,'TESTPHYS: ON PREND LA PUIS ',1./float(nsplit*nsplit_phy)
     392     s   ,'  DES FRAC A IT=',itau
     393      frac_impa(:,:)=frac_impa(:,:)**(1./float(nsplit*nsplit_phy))
     394      frac_nucl(:,:)=frac_nucl(:,:)**(1./float(nsplit*nsplit_phy))
    382395c    ...  ouverture du fichier de stockage netcdf ...
    383396C
    … …  
    391404         mode=1
    392405
    393          CALL initdynav(dynhistave_file,day_ini,anne_ini,dtav,
    394      .              t_ops, t_wrt, nq,mode, histaveid)
     406c        CALL initdynav(dynhistave_file,day_ini,anne_ini,dtav,
     407c    .              t_ops, t_wrt, nq,mode, histaveid)
    395408
    396409         pi=2.*asin(1.)
    … …  
    832845             do iii=1,nsplit_phy
    833846C
     847      lafin=.false. ! en attendant mieux.
    834848      print*,'dtphys avant phytrac ',dtphys
    835              call phytrac(rnpb,
    836      I                   ecritphy, debutphy,
     849      print*,'TESTPHYS: APPEL A PHYTRAC IT=',itau
     850
     851             call phytrac(rnpb,ecritphy,
     852c    I                   ecritphy, debutphy,
     853     I                   debutphy, lafin,
    837854     I                   nq,
    838855     I                   ngridmx,llm,dtphys,
    … …  
    855872             itauav=(itau-1)*nsplit+isplit
    856873c             itauav=itau*nsplit+isplit
    857              CALL writedynav(histaveid, nq,mode, itauav,vcov ,
    858      ,                   ucov,teta,pk,phi,q,masse,ps,phis)
     874c            CALL writedynav(histaveid, nq,mode, itauav,vcov ,
     875c    ,                   ucov,teta,pk,phi,q,masse,ps,phis)
    859876c            qmoy(:,:,:)=qmoy(:,:,:)+q(:,:,1,:)
    860877         do iq=1,nq

  • LMDZ.3.3/trunk/libf/dyn3d/read_reanalyse.F

    r198 r204  
     1c
    12c $Header
     3c
    24      subroutine read_reanalyse(timestep,u,v,t,masse,ps,mode)
    35
    … …  
    1416      integer nlevnc
    1517cModef 11-2-99      parameter (nlevnc=15)
    16       parameter (nlevnc=15)
     18      parameter (nlevnc=21)
    1719      integer timestep,mode,l
    1820
    … …  
    5860            varidt=NCVID(ncidt,'AIR',rcode)
    5961            print*,'ncidt,varidt',ncidt,varidt
    60             ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
    61             varidps=NCVID(ncidps,'SP',rcode)
    62             print*,'ncidps,varidps',ncidps,varidps
     62c           ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
     63c           varidps=NCVID(ncidps,'SP',rcode)
     64c           print*,'ncidps,varidps',ncidps,varidps
    6365      endif
    6466
    … …  
    106108      count(4)=0
    107109c  ps
    108       status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)
     110c     status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)
    109111c     call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')
    110       call correctbid(iim,jjp1,psnc)
     112c     call correctbid(iim,jjp1,psnc)
    111113
    112114c   Transformations
    … …  
    187189c -----------------------------------------------------------------
    188190
    189       do j=1,jjp1
    190          do i=1,iim
    191             ps(i,j)=psnc(i,jjp1+1-j)
    192          enddo
    193          ps(iip1,j)=ps(1,j)
    194       enddo
     191c     do j=1,jjp1
     192c        do i=1,iim
     193c           ps(i,j)=psnc(i,jjp1+1-j)
     194c        enddo
     195c        ps(iip1,j)=ps(1,j)
     196c     enddo
    195197
    196198      CALL pression( ip1jmp1, ap, bp, ps, p )
    … …  
    200202      unskap=1./kappa
    201203      prefkap =  preff  ** kappa
    202       PRINT *,' Pref kappa unskap  ',preff,kappa,unskap
     204c     PRINT *,' Pref kappa unskap  ',preff,kappa,unskap
    203205      DO l = 1, llm
    204206       DO j=1,jjp1

  • LMDZ.3.3/trunk/libf/dyn3d/redecoupenc.F

    r198 r204  
     1c
    12c $Header
     3c
    24      SUBROUTINE redecoupenc
    35     s     (irec,massemn,pbarun,pbarvn,wn,tetan,phin,
    4      s     nrec,avant,airefi,
    5      s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
    6      s     yu1,yv1,ftsol,pctsrf,
    7      s     frac_impa,frac_nucl,phisn)
     6     s     nrec,avant,airefin,phisfin,
     7     s     tn,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkzn,
     8     s     yu1n,yv1n,ftsoln,pctsrfn,
     9     s     frac_impan,frac_nucln,phisn)
    810
    911      IMPLICIT NONE
    … …  
    1113#include "dimensions.h"
    1214#include "paramet.h"
    13 
    1415#include "comvert.h"
    1516#include "comconst.h"
    1617#include "comgeom2.h"
    17 
    1818#include "tracstoke.h"
     19#include "logic.h"
    1920
    2021      integer irec,nrec,i,j
    21 
    2222      integer ig,l
    2323      integer imo,jmo,imn,jmn,ii,jj,ig
    … …  
    3232      real zmfd(ngridn,llm),zde_d(ngridn,llm),zen_d(ngridn,llm)
    3333      real zmfu(ngridn,llm),zde_u(ngridn,llm),zen_u(ngridn,llm)
    34       real mfd(ngridn,llm),de_d(ngridn,llm),en_d(ngridn,llm)
    35       real mfu(ngridn,llm),de_u(ngridn,llm),en_u(ngridn,llm)
    3634       
    37         real*4 airedy(iip1,jjp1)
    38       real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
    39      . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
    40 
    41       real coefkz(ngridn,llm)
    42       real frac_impa(ngridn,llm),frac_nucl(ngridn,llm)
    43       real yu1(ngridn), yv1(ngridn)
    44       real ftsol(ngridn,nbsrf),pctsrf(ngridn,nbsrf)
    45       integer imfu,imfd,ien_u,ide_u,
    46      s      ien_d,ide_d,
    47      s      icoefkz,izu1,izv1,
    48      s      itsol,ipsf,
    49      s      ilei, ilec
    50       parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
    51      s      ien_d=4*llm+1,ide_d=5*llm+1,
    52      s      icoefkz=6*llm+1,
    53      s      ilei=7*llm+1,ilec=8*llm+1,
    54      s      izu1=9*llm+1,izv1=9*llm+2,
    55      s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
    56       logical avant
    57 
     35       logical avant
    5836
    5937      real massefi(ngridn,llm)
    … …  
    6341      real wn(imn+1,jmn+1,llm),phin(imn+1,jmn+1,llm)
    6442      real phisn(imn+1,jmn+1)
    65       real phisfi(imn,jmn+1)
     43
    6644      real massemo(imo+1,jmo+1,llm),tetao(imo+1,jmo+1,llm)
    6745      real pbaruo(imo+1,jmo+1,llm),pbarvo(imo+1,jmo,llm)
    … …  
    7149      real pbarvst(imo+1,jmo+1,llm)
    7250
    73       real airefi(ngridn)
    74 
    75       real xlecn(ngridn,9*llm+2+2*nbsrf),tmpn(imn+1,jmn+1)
    76       real xleco(ngrido,9*llm+2+2*nbsrf),tmpo(imo+1,jmo+1)
     51      real tmpo2(imo+1,jmo+1,llm),tmpo1(imo,jmo+1,llm)
     52      real tmpo4(imo+1,jmo+1,nbsrf),tmpo3(imo,jmo+1,nbsrf)
     53      real tmpo6(imo+1,jmo+1),tmpo5(imo,jmo+1)
     54      real tmpn6(imn+1,jmn+1),tmpn5(imn,jmn+1)
     55      real tmpn2(imn+1,jmn+1,llm),tmpn1(imn,jmn+1,llm)
     56      real tmpn4(imn+1,jmn+1,nbsrf),tmpn3(imn,jmn+1,nbsrf)
     57
     58        real airefio(ngrido),phisfio(ngrido),
     59     .    mfuo(ngrido,llm),mfdo(ngrido,llm),en_uo(ngrido,llm),
     60     .    de_uo(ngrido,llm),en_do(ngrido,llm),
     61     .    de_do(ngrido,llm),coefkzo(ngrido,llm),
     62     .    frac_impao(ngrido,llm),frac_nuclo(ngrido,llm),
     63     .    yu1o(ngrido),yv1o(ngrido),ftsolo(ngrido,nbsrf),
     64     .    pctsrfo(ngrido,nbsrf),to(ngrido,llm)
     65
     66      real airefin(ngridn),phisfin(ngridn),
     67     .    mfun(ngridn,llm),en_un(ngridn,llm),mfdn(ngridn,llm),
     68     .    de_un(ngridn,llm),en_dn(ngridn,llm),
     69     .    de_dn(ngridn,llm),coefkzn(ngridn,llm),
     70     .    frac_impan(ngridn,llm),frac_nucln(ngridn,llm),
     71     .    ftsoln(ngridn,nbsrf),yu1n(ngridn),yv1n(ngridn),
     72     .    pctsrfn(ngridn,nbsrf),tn(ngridn,llm)
    7773
    7874      real zcontrole(ngridn),zmass,tmpdyn(imn+1,jmn+1),zflux
    7975
    80       real ziadvtrac,zrec,ziadvtrac2,zrec2
    81       real zim,zjm,zlm,zklon,zklev
     76      real ziadvtrac,ziadvtrac2,zrec2
     77      integer zim,zjm,zlm,zklon,zklev,zrec
    8278
    8379      real zpi
     80
    8481c  longitudes et latitudes lues
    85       real rlonul(1:imo+1),rlatvl(1:jmo)
    86       real rlonvl(1:imo+1),rlatul(1:jmo+1)
     82      real rlonul(imo+1,jmo+1),rlatvl(imo+1,jmo)
     83      real rlonvl(imo+1,jmo),rlatul(imo+1,jmo+1)
    8784c  longitudes et latitudes anciennes
    8885      real rlonuo(0:imo+1),rlatvo(0:jmo+1)
     86      real rlonvo(0:imo+1),rlatuo(0:jmo+1)
    8987c  longitudes et latitudes nouvelles
    9088      real rlonun(0:imn+1),rlatvn(0:jmn+1)
     89      real rlonvn(0:imn+1),rlatun(0:jmn+1)
    9190      real aireo(imo+1,jmo+1)
    9291
    … …  
    9594      real alphaxo(imo+1)
    9695      real alpha(imn+1,jmn+1)
    97 
     96       real alphat(imn+1,jmn+1,llm)
    9897      real aa,uu(0:imo+1),vv(imo+1,0:jmo+1)
    9998
    … …  
    105104      integer i,j
    106105      real dlatm,dlatp,dlonm,dlonp
    107 
    108 
     106c abd
     107       character*10 file
     108       character*10 nom
     109       character*2 str2
     110c fin ab
    109111      zpi=2.*asin(1.)
    110112
    … …  
    161163
    162164      iest(1)=0
     165        print*,'iest(1)=0'
    163166      do io=2,imo+1
    164167         iest(io)=iest(io-1)+ndecx(io-1)
    165168         iouest(io-1)=iest(io)
     169        print*,'iest(',io,')=',iest(io),'iouest('
     170     s              ,io-1,')=',iouest(io-1)
     171       
    166172      enddo
    167173      iouest(imo+1)=iest(imo+1)+ndecx(imo+1)
     174        print*,'iouest(',imo+1,')=',iouest(imo+1)
    168175
    169176      jnord(1)=0
     177        print*,'jnord(1)=0'
    170178      do jo=2,jmo+1
    171179         jnord(jo)=jnord(jo-1)+ndecy(jo-1)
    172180         jsud(jo-1)=jnord(jo)
     181        print*,'jnord(',jo,')=',jnord(jo),'jsud('
     182     s              ,jo-1,')=',jsud(jo-1)
    173183      enddo
    174184      jsud(jmo+1)=jnord(jmo+1)+ndecy(jmo+1)
     185                print*,'jsud(',jmo+1,')=',jsud(jmo+1)
    175186
    176187c==================================================================
    … …  
    182193        CALL read_fstoke(0,
    183194     .   zrec,zim,zjm,zlm,
    184      .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,aireo,phiso,
     195     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
    185196     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
    186 
    187         print*,'zrec,zdtvr,ziadvtrac,zim,zjm,zlm'
     197     
     198      print*,'zrec,zdtvr,ziadvtrac,zim,zjm,zlm'
    188199      print*,zrec,zdtvr,ziadvtrac,zim,zjm,zlm
    189 
    190       if((imo-nint(zim))*(jmo-nint(zjm)).ne.0) then
    191         print*,'Modifier les dimensions dans redecoupe '
    192         print*,'Mettre imo=',zim,'   jmo=',zjm
    193         stop
    194       endif
    195 
    196         CALL read_pstoke(0,
    197      .   zrec,zklon,zklev,airefi,phisfi,
    198      .   mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
    199      .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
    200        
    201         print*,'Entete du fichier physique'
    202       print*,zrec2,ziadvtrac2,zklon,zklev
    203200
    204201      nrec=zrec
    … …  
    207204      istphy=ziadvtrac2
    208205
     206      print*,'rlonul '
     207      do io=1,imo+1
     208         print*,io,rlonul(io,1)
     209      enddo
     210        print*,'rlonvl '
     211      do io=1,imo+1
     212         print*,io,rlonvl(io,1)
     213      enddo
     214        print*,'rlatul '
     215      do jo=1,jmo+1
     216         print*,jo,rlatul(1,jo)
     217      enddo
     218        print*,'rlatvl'
     219      do jo=1,jmo
     220         print*,jo,rlatvl(1,jo)
     221      enddo
     222     
     223c      if((imo-nint(zim))*(jmo-nint(zjm)).ne.0) then
     224c        print*,'Modifier les dimensions dans redecoupe '
     225c        print*,'Mettre imo=',zim,'   jmo=',zjm
     226c  abderr      stop
     227c      endif
     228
     229c abderrahmane
     230        if(physic)then
     231        CALL read_pstoke(0,
     232     .   zrec,zklon,zklev,airefio,phisfio,
     233     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
     234     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
     235       
     236        print*,'Entete du fichier physique'
     237        print*,zrec,zklon,zklev
     238        endif
     239
     240
    209241c==================================================================
    210242c   Definition des anciennes latitudes et longitudes
    … …  
    212244c==================================================================
    213245
    214       rlonuo(0)=-zpi
     246
    215247      do io=1,imo
    216 c        rlonuo(io)=2.*zpi/FLOAT(imo)*(io+0.5-0.5*FLOAT(imo)-1.)
    217 c        print*,'LON ',io,rlonuo(io),rlonul(io)
    218          rlonuo(io)=rlonul(io)
    219       enddo
    220       rlonuo(imo+1)=zpi
     248         rlonuo(io)=rlonul(io,1)*zpi/180.
     249        print*,'LON ',io,rlonuo(io)*180./zpi
     250      enddo
     251c abderr
     252      rlonuo(imo+1)=0.5*(rlonul(imo,1)+rlonul(imo+1,1))*zpi/180.
     253      print*,'LON ',imo+1,rlonuo(imo+1)*180./zpi
     254      rlonuo(0)=rlonuo(imo+1)-2.*zpi
     255      print*,'LON ',0,rlonuo(0)*180./zpi
     256
     257c abder
     258c ATTENTION A REVOIR
     259c       goto 22
     260      do io=1,imo
     261         rlonvo(io)=rlonvl(io,1)*zpi/180.
     262        print*,'LON ',io,rlonvo(io)*180./zpi
     263      enddo
     264      rlonvo(imo+1)=0.5*(rlonvl(imo,1)+rlonvl(imo+1,1))*zpi/180.
     265      print*,'LON ',imo+1,rlonvo(imo+1)*180./zpi
     266      rlonvo(0)=rlonvo(imo+1)-2.*zpi
     267      print*,'LON ',0,rlonvo(0)*180./zpi
     26822    continue
     269c fin ab
    221270
    222271      rlatvo(0)=zpi/2.
     272      print*,'LAT ',0,rlatvo(0)*180./zpi
    223273      do jo=1,jmo
    224 c        rlatvo(jo)=zpi/FLOAT(jmo)*(0.5*FLOAT(jmo)+1.-jo-0.5)
    225 c        print*,'LAT ',jo,rlatvo(jo),rlatvl(jo)
    226          rlatvo(jo)=rlatvl(jo)
    227       enddo
    228       rlatvo(jmo+1)=-zpi/2.
    229 
    230 c     do jo=1,jmo+1
    231 c        do io=1,imo+1
    232 c           aireo(io,jo)=rad*rad
    233 c    s         *(rlonuo(io)-rlonuo(io-1))
    234 c    s         *(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
    235 c           aireo(io,jo)=airel(io,jo)
    236 c        enddo
    237 c        aireo(1,jo)=aireo(1,jo)+aireo(imo+1,jo)
    238 c        aireo(imo+1,jo)=aireo(1,jo)
    239 c     enddo
     274        rlatvo(jo)=rlatvl(1,jo)*zpi/180.
     275        print*,'LAT ',jo,rlatvo(jo)*180./zpi
     276      enddo
     277        rlatvo(jmo+1)=-zpi/2.
     278        print*,'LAT ',jmo+1,rlatvo(jmo+1)*180./zpi
     279c abd
     280c ATTENTION A REVOIR
     281c       goto 33
     282c      rlatuo(0)=zpi/2.
     283c      print*,'LAT ',0,rlatuo(0)*180./zpi
     284      do jo=1,jmo+1
     285        rlatuo(jo-1)=rlatul(1,jo)*zpi/180.
     286        print*,'LAT ',jo-1,rlatuo(jo-1)*180./zpi
     287      enddo
     288        rlatuo(jmo+1)=-zpi/2.
     289        print*,'LAT ',jmo+1,rlatuo(jmo+1)*180./zpi
     29033    continue
     291c abd
    240292
    241293      do io=2,imo
    … …  
    250302c==================================================================
    251303
    252       rlonun(0)=-zpi
     304c Nouvelles longitudes rlonun
     305      rlonun(0)=rlonuo(0)
    253306      do io=1,imo+1
    254307         do iin=1,iouest(io)-iest(io)
    … …  
    259312            alphax(in)=alphaxo(io)/ndecx(io)
    260313            print787,io,rlonuo(io-1)*180./zpi,in
    261      s      ,iest(io),iouest(io),rlonun(in)*180./zpi,alphax(in)
    262          enddo
    263       enddo
    264 
     314     s  ,iest(io),iouest(io),rlonun(in)*180./zpi,alphax(in)
     315         enddo
     316      enddo
     317
     318c Nouvelles longitudes rlonvn
     319c       goto 44
     320      rlonvn(0)=rlonvo(0)
     321      do io=1,imo+1
     322         do iin=1,iouest(io)-iest(io)
     323            in=iin+iest(io)
     324            rlonvn(in)=
     325     s      rlonvo(io-1)+iin*(rlonvo(io)-rlonvo(io-1))
     326     s      /ndecx(io)
     327            alphax(in)=alphaxo(io)/ndecx(io)
     328            print787,io,rlonvo(io-1)*180./zpi,in
     329     s  ,iest(io),iouest(io),rlonvn(in)*180./zpi,alphax(in)
     330         enddo
     331      enddo
     33244    continue
     333
     334c Nouvelles latitudes rlatvn
    265335      rlatvn(0)=0.5*zpi
    266336      do jo=1,jmo+1
    267          print*,'jo=',jo
    268337         do jjn=1,jsud(jo)-jnord(jo)
    269338            jn=jnord(jo)+jjn
    270             rlatvn(jn)=rlatvo(jo-1)+jjn*(rlatvo(jo)-rlatvo(jo-1))
     339            rlatvn(jn)=
     340     s      rlatvo(jo-1)+jjn*(rlatvo(jo)-rlatvo(jo-1))
    271341     s      /ndecy(jo)
    272342            alphay(jn)=(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
    273343     s                /(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
    274             print787,jo,rlatvo(jo-1)*180./zpi,jn
    275      s      ,jnord(jo),jsud(jo),rlatvn(jn)*180./zpi,alphay(jn)
    276          enddo
    277       enddo
    278 
    279 787   format(i5,f10.2,3(i5),2(f10.2))
     344           print*,jn,rlatvn(jn)*180./zpi
     345         enddo
     346      enddo
     347
     348c Nouvelles latitudes rlatun
     349c       goto 55
     350      rlatun(0)=0.5*zpi
     351      do jo=1,jmo+1
     352         do jjn=1,jsud(jo)-jnord(jo)
     353            jn=jnord(jo)+jjn
     354            rlatun(jn)=
     355     s      rlatuo(jo-1)+jjn*(rlatuo(jo)-rlatuo(jo-1))
     356     s      /ndecy(jo)
     357           print*,jn,rlatvn(jn)*180./zpi
     358         enddo
     359      enddo
     36055    continue
     361
     362787   format(i5,f10.2,3(i5),2(f12.6))
    280363      do in=1,imn
    281364         rlonu(in)=rlonun(in)
    … …  
    295378         do in=1,imn
    296379            alpha(in,jn)=alphax(in)*alphay(jn)
     380            alphat(in,jn,1)=alpha(in,jn)
    297381         enddo
    298382         alpha(imn+1,jn)=0.
    299       enddo
    300 
     383         alphat(imn+1,jn,1)=0.
     384      enddo
     385c abderr 19 4 00
     386        do l=2,llm
     387         do jn=1,jmn+1
     388         do in=1,imn+1
     389          alphat(in,jn,l)=alphat(in,jn,1)
     390         enddo
     391         enddo
     392        enddo
    301393c     call dump2d(iip1,jjp1,alpha,'ALPHA   ')
    302394
    … …  
    358450c     call dump2d(iip1,jjp1,aire,'AIRE   ')
    359451
    360 c     do jn=1,jjp1
    361 c        do in=1,iim
    362 c           aire(in,jn)=rad*rad*(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
    363 c    s      *(rlonun(in)-rlonun(in-1))
    364 c           unsaire(in,jn)=1./aire(in,jn)
    365 c        enddo
    366 c        aire(iip1,jn)=aire(1,jn)
    367 c        unsaire(iip1,jn)=unsaire(1,jn)
    368 c     enddo
    369 c     call dump2d(iip1,jjp1,aire,'AIRE2   ')
    370452      DO 42 j = 1,jjp1
    371453      DO 41 i = 1,iim
    … …  
    404486         enddo
    405487      enddo
    406 
    407 
     488        Print*,'Fin irec=0'
     489        go to 435
     490      file='pbur'
     491      call inigrads(11,iip1
     492     s  ,rlonu,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
     493     s  ,llm,presnivs,1.
     494     s  ,1800.,file,'gcmq2 ')
     495      file='pbvr'
     496      call inigrads(12,iip1
     497     s  ,rlonv,180./pi,-180.,180.,jjm,rlatv,-90.,90.,180./pi
     498     s  ,llm,presnivs,1.
     499     s  ,1800.,file,'gcmq2 ')
     500435   continue
    408501c==================================================================
    409502c   Fin des initialisations
    … …  
    415508c   Lecture des fichiers fluxmass et  physique:
    416509c   -----------------------------------------------------
    417        
     510        print*,'Entrer dans read_fstoke a irec=',irec
    418511        CALL read_fstoke(irec,
    419512     .   zrec,zim,zjm,zlm,
    420      .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,aireo,phiso,
     513     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
    421514     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
    422515
    423         do l=1,llm
    424            do j=1,jmo
    425               do i=1,imo+1
    426                  pbarvo(i,j,l)=pbarvst(i,j,l)
    427               enddo
    428            enddo
    429         enddo
     516        print*,'Apres read_fstoke a irec=',irec
     517
     518c       do l=1,llm
     519c           do j=1,jmo
     520c              do i=1,imo+1
     521c                 pbarvo(i,j,l)=pbarvst(i,j,l)
     522c              enddo
     523c           enddo
     524c        enddo
    430525
    431526         do l=1,llm
    … …  
    434529                  do jn=jnord(jo)+1,jsud(jo)
    435530                     do in=iest(io)+1,iouest(io)
    436                         wn(in,jn,l)=alpha(in,jn)*wo(io,jo,l)
    437                         massemn(in,jn,l)=alpha(in,jn)
    438      s                     *massemo(io,jo,l)
     531c                        wn(in,jn,l)=alpha(in,jn)*wo(io,jo,l)
     532c                        massemn(in,jn,l)=alpha(in,jn)
     533                       wn(in,jn,l)=alphat(in,jn,l)*wo(io,jo,l)
     534                       massemn(in,jn,l)=alphat(in,jn,l)
     535     s                                *massemo(io,jo,l)
    439536                        tetan(in,jn,l)=tetao(io,jo,l)
    440537                        phin(in,jn,l)=phio(io,jo,l)
    441 c marine               
    442                         phisn(i,jn) = phiso(io,jo)
    443538                     enddo
    444539                  enddo
    … …  
    450545               tetan(imn+1,jn,l)=tetan(1,jn,l)
    451546               phin(imn+1,jn,l)=phin(1,jn,l)
    452 c marine
    453                 phisn(imn+1,jn)=phisn(1,jn)
    454 
    455             enddo
    456          enddo
    457 
     547            enddo
     548         enddo
     549c Test massemn
     550        print*,'MASSE DANS LA NOUVELLE GRILLE'
     551        goto 908
     552        do jo=1,jmo+1
     553               do io=1,imo+1
     554                  do jn=jnord(jo)+1,jsud(jo)
     555                     do in=iest(io)+1,iouest(io)
     556        print*,'massemn(',in,jn,1,')=',massemn(in,jn,1)
     557                     enddo
     558                  enddo
     559               enddo
     560        enddo
     561        do jn=1,jmn+1
     562        print*,'massemn(',imn+1,jn,1,')=',massemn(imn+1,jn,1)
     563        enddo
     564908     continue
     565        print*,'Fin calcul de massemn pour nouv. gril.'
    458566         do l=1,llm
    459567            do jo=1,jmo+1
    … …  
    478586            enddo
    479587         enddo
     588        print*,'Fin calcul de pbarun'
    480589       
    481590        do l=1,llm
    … …  
    507616         enddo
    508617
    509        
    510         CALL read_pstoke(irec,
    511      .   zrec,zklon,zklev,airefi,phisfi,
    512      .   mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
    513      .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
    514 
     618c abd
     619        go to 456
     620        nom='pbaru'
     621        call wrgrads(11,llm,pbarun(:,:,1),nom,nom)
     622        nom='pbarv'
     623        call wrgrads(12,llm,pbarvn(:,:,1),nom,nom)
     624        nom='masse'
     625        call wrgrads(11,llm,massemn(:,:,1),nom,nom)
     626        nom='w'
     627        call wrgrads(11,llm,wn(:,:,1),nom,nom)
     628456     continue
     629c fin ab
     630
     631        if(physic)then
     632        CALL read_pstoke(irec,
     633     .   zrec,zklon,zklev,airefio,phisfio,
     634     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
     635     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
     636        print*,'OK read_pstoke pour irec=',irec
    515637c==================================================================
    516638c  Passage  a la nouvelle grille
    517639c==================================================================
    518          do l=1,9*llm+2+2*nbsrf
    519 c   passage aa la grille dynamique ancienne
    520             do io=1,imo+1
    521                tmpo(io,1)=xleco(1,l)
    522                tmpo(io,jmo+1)=xleco(ngrido,l)
    523             enddo
    524             do jo=2,jmo
    525                do io=1,imo
    526                   tmpo(io,jo)=xleco((jo-2)*imo+io+1,l)
    527                enddo
    528                tmpo(imo+1,jo)=tmpo(1,jo)
    529             enddo
    530 c   passage a la grillle dynamique nouvelle
    531             do jo=1,jmo+1
    532                do io=1,imo+1
    533                   do jn=jnord(jo)+1,jsud(jo)
    534                      do in=iest(io)+1,iouest(io)
    535                         tmpn(in,jn)=tmpo(io,jo)
    536                      enddo
    537                   enddo
    538                enddo
    539             enddo
    540 c   passage a la grille physique nouvelle
    541             xlecn(1,l)=tmpn(1,1)
    542             xlecn(ngridn,l)=tmpn(1,jmn+1)
    543             do jn=2,jmn
    544                do in=1,imn
    545                   xlecn((jn-2)*imn+in+1,l)=tmpn(in,jn)
    546                enddo
    547             enddo
    548          enddo
    549 
     640        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,to,tmpo1)
     641        do l=1,llm
     642           do jo=1,jmo+1
     643              do io=1,imo
     644                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     645              enddo
     646           enddo
     647
     648                tmpo2(imo+1,1,l)=to(1,l)
     649                tmpo2(imo+1,jmo+1,l)=to(ngrido,l)
     650            do jo=2,jmo
     651                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     652            enddo
     653c   passage a la grillle dynamique nouvelle
     654            do jo=1,jmo+1
     655               do io=1,imo+1
     656                  do jn=jnord(jo)+1,jsud(jo)
     657                     do in=iest(io)+1,iouest(io)
     658                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     659                     enddo
     660                  enddo
     661               enddo
     662            enddo
     663            do jn=1,jmn+1
     664               do in=1,imn
     665                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     666               enddo
     667            enddo
     668        enddo
     669        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,tn)
     670        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     671        call initial0(llm*imo*(jmo+1),tmpo1)
     672        call initial0(llm*imn*(jmn+1),tmpn1)
     673        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     674
     675        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfuo,tmpo1)
     676        do l=1,llm
     677           do jo=1,jmo+1
     678              do io=1,imo
     679                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     680              enddo
     681           enddo
     682
     683                tmpo2(imo+1,1,l)=mfuo(1,l)
     684                tmpo2(imo+1,jmo+1,l)=mfuo(ngrido,l)
     685            do jo=2,jmo
     686                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     687            enddo
     688c   passage a la grillle dynamique nouvelle
     689            do jo=1,jmo+1
     690               do io=1,imo+1
     691                  do jn=jnord(jo)+1,jsud(jo)
     692                     do in=iest(io)+1,iouest(io)
     693                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     694                     enddo
     695                  enddo
     696               enddo
     697            enddo
     698            do jn=1,jmn+1
     699               do in=1,imn
     700                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     701               enddo
     702            enddo
     703        enddo
     704        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfun)
     705        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     706        call initial0(llm*imo*(jmo+1),tmpo1)
     707        call initial0(llm*imn*(jmn+1),tmpn1)
     708        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     709        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfdo,tmpo1)
     710        do l=1,llm
     711           do jo=1,jmo+1
     712              do io=1,imo
     713                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     714              enddo
     715           enddo
     716
     717                tmpo2(imo+1,1,l)=mfdo(1,l)
     718                tmpo2(imo+1,jmo+1,l)=mfdo(ngrido,l)
     719            do jo=2,jmo
     720                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     721            enddo
     722c   passage a la grillle dynamique nouvelle
     723            do jo=1,jmo+1
     724               do io=1,imo+1
     725                  do jn=jnord(jo)+1,jsud(jo)
     726                     do in=iest(io)+1,iouest(io)
     727                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     728                     enddo
     729                  enddo
     730               enddo
     731            enddo
     732            do jn=1,jmn+1
     733               do in=1,imn
     734                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     735               enddo
     736            enddo
     737        enddo
     738        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfdn)
     739        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     740        call initial0(llm*imo*(jmo+1),tmpo1)
     741        call initial0(llm*imn*(jmn+1),tmpn1)
     742        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     743        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_uo,tmpo1)
     744        do l=1,llm
     745           do jo=1,jmo+1
     746              do io=1,imo
     747                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     748              enddo
     749           enddo
     750
     751                tmpo2(imo+1,1,l)=en_uo(1,l)
     752                tmpo2(imo+1,jmo+1,l)=en_uo(ngrido,l)
     753            do jo=2,jmo
     754                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     755            enddo
     756c   passage a la grillle dynamique nouvelle
     757            do jo=1,jmo+1
     758               do io=1,imo+1
     759                  do jn=jnord(jo)+1,jsud(jo)
     760                     do in=iest(io)+1,iouest(io)
     761                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     762                     enddo
     763                  enddo
     764               enddo
     765            enddo
     766            do jn=1,jmn+1
     767               do in=1,imn
     768                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     769               enddo
     770            enddo
     771        enddo
     772        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_un)
     773        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     774        call initial0(llm*imo*(jmo+1),tmpo1)
     775        call initial0(llm*imn*(jmn+1),tmpn1)
     776        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     777        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_do,tmpo1)
     778        do l=1,llm
     779           do jo=1,jmo+1
     780              do io=1,imo
     781                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     782              enddo
     783           enddo
     784
     785                tmpo2(imo+1,1,l)=en_do(1,l)
     786                tmpo2(imo+1,jmo+1,l)=en_do(ngrido,l)
     787            do jo=2,jmo
     788                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     789            enddo
     790c   passage a la grillle dynamique nouvelle
     791            do jo=1,jmo+1
     792               do io=1,imo+1
     793                  do jn=jnord(jo)+1,jsud(jo)
     794                     do in=iest(io)+1,iouest(io)
     795                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     796                     enddo
     797                  enddo
     798               enddo
     799            enddo
     800            do jn=1,jmn+1
     801               do in=1,imn
     802                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     803               enddo
     804            enddo
     805        enddo
     806        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_dn)
     807        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     808        call initial0(llm*imo*(jmo+1),tmpo1)
     809        call initial0(llm*imn*(jmn+1),tmpn1)
     810        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     811        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_do,tmpo1)
     812        do l=1,llm
     813           do jo=1,jmo+1
     814              do io=1,imo
     815                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     816              enddo
     817           enddo
     818
     819                tmpo2(imo+1,1,l)=de_do(1,l)
     820                tmpo2(imo+1,jmo+1,l)=de_do(ngrido,l)
     821            do jo=2,jmo
     822                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     823            enddo
     824c   passage a la grillle dynamique nouvelle
     825            do jo=1,jmo+1
     826               do io=1,imo+1
     827                  do jn=jnord(jo)+1,jsud(jo)
     828                     do in=iest(io)+1,iouest(io)
     829                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     830                     enddo
     831                  enddo
     832               enddo
     833            enddo
     834            do jn=1,jmn+1
     835               do in=1,imn
     836                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     837               enddo
     838            enddo
     839        enddo
     840        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_dn)
     841        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     842        call initial0(llm*imo*(jmo+1),tmpo1)
     843        call initial0(llm*imn*(jmn+1),tmpn1)
     844        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     845        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_uo,tmpo1)
     846        do l=1,llm
     847           do jo=1,jmo+1
     848              do io=1,imo
     849                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     850              enddo
     851           enddo
     852
     853                tmpo2(imo+1,1,l)=de_uo(1,l)
     854                tmpo2(imo+1,jmo+1,l)=de_uo(ngrido,l)
     855            do jo=2,jmo
     856                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     857            enddo
     858c   passage a la grillle dynamique nouvelle
     859            do jo=1,jmo+1
     860               do io=1,imo+1
     861                  do jn=jnord(jo)+1,jsud(jo)
     862                     do in=iest(io)+1,iouest(io)
     863                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     864                     enddo
     865                  enddo
     866               enddo
     867            enddo
     868            do jn=1,jmn+1
     869               do in=1,imn
     870                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     871               enddo
     872            enddo
     873        enddo
     874        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_un)
     875        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     876        call initial0(llm*imo*(jmo+1),tmpo1)
     877        call initial0(llm*imn*(jmn+1),tmpn1)
     878        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     879        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,coefkzo,tmpo1)
     880        do l=1,llm
     881           do jo=1,jmo+1
     882              do io=1,imo
     883                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     884              enddo
     885           enddo
     886
     887           tmpo2(imo+1,1,l)=coefkzo(1,l)
     888           tmpo2(imo+1,jmo+1,l)=coefkzo(ngrido,l)
     889
     890           do jo=2,jmo
     891                tmpo2(imo+1,jo,l)=tmpo2(1,jo,l)
     892           enddo
     893        enddo
     894             
     895c   passage a la grillle dynamique nouvelle
     896        do l=1,llm     
     897            do jo=1,jmo+1
     898               do io=1,imo+1
     899                  do jn=jnord(jo)+1,jsud(jo)
     900                     do in=iest(io)+1,iouest(io)
     901                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     902                     enddo
     903                  enddo
     904               enddo
     905            enddo
     906            do jn=1,jmn+1
     907               do in=1,imn
     908                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     909               enddo
     910            enddo
     911        enddo
     912        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,coefkzn)
     913        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     914        call initial0(llm*imo*(jmo+1),tmpo1)
     915        call initial0(llm*imn*(jmn+1),tmpn1)
     916        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     917        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_impao,tmpo1)
     918        do l=1,llm
     919           do jo=1,jmo+1
     920              do io=1,imo
     921                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     922              enddo
     923           enddo
     924
     925                tmpo2(imo+1,1,l)=frac_impao(1,l)
     926                tmpo2(imo+1,jmo+1,l)=frac_impao(ngrido,l)
     927            do jo=2,jmo
     928                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     929            enddo
     930c   passage a la grillle dynamique nouvelle
     931            do jo=1,jmo+1
     932               do io=1,imo+1
     933                  do jn=jnord(jo)+1,jsud(jo)
     934                     do in=iest(io)+1,iouest(io)
     935                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     936                     enddo
     937                  enddo
     938               enddo
     939            enddo
     940            do jn=1,jmn+1
     941               do in=1,imn
     942                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     943               enddo
     944            enddo
     945        enddo
     946        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_impan)
     947        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
     948        call initial0(llm*imo*(jmo+1),tmpo1)
     949        call initial0(llm*imn*(jmn+1),tmpn1)
     950        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
     951        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_nuclo,tmpo1)
     952        do l=1,llm
     953           do jo=1,jmo+1
     954              do io=1,imo
     955                tmpo2(io,jo,l)=tmpo1(io,jo,l)
     956              enddo
     957           enddo
     958
     959                tmpo2(imo+1,1,l)=frac_nuclo(1,l)
     960                tmpo2(imo+1,jmo+1,l)=frac_nuclo(ngrido,l)
     961            do jo=2,jmo
     962                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
     963            enddo
     964c   passage a la grillle dynamique nouvelle
     965            do jo=1,jmo+1
     966               do io=1,imo+1
     967                  do jn=jnord(jo)+1,jsud(jo)
     968                     do in=iest(io)+1,iouest(io)
     969                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
     970                     enddo
     971                  enddo
     972               enddo
     973            enddo
     974            do jn=1,jmn+1
     975               do in=1,imn
     976                tmpn1(in,jn,l)=tmpn2(in,jn,l)
     977               enddo
     978            enddo
     979        enddo
     980        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_nucln)
     981
     982        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,ftsolo,tmpo3)
     983        do l=1,nbsrf
     984           do jo=1,jmo+1
     985              do io=1,imo
     986                tmpo4(io,jo,l)=tmpo3(io,jo,l)
     987              enddo
     988           enddo
     989
     990                tmpo4(imo+1,1,l)=ftsolo(1,l)
     991                tmpo4(imo+1,jmo+1,l)=ftsolo(ngrido,l)
     992            do jo=2,jmo
     993                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
     994            enddo
     995c   passage a la grillle dynamique nouvelle
     996            do jo=1,jmo+1
     997               do io=1,imo+1
     998                  do jn=jnord(jo)+1,jsud(jo)
     999                     do in=iest(io)+1,iouest(io)
     1000                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
     1001                     enddo
     1002                  enddo
     1003               enddo
     1004            enddo
     1005            do jn=1,jmn+1
     1006               do in=1,imn
     1007                tmpn3(in,jn,l)=tmpn4(in,jn,l)
     1008               enddo
     1009            enddo
     1010        enddo
     1011        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,ftsoln)
     1012
     1013        call initial0(nbsrf*(imo+1)*(jmo+1),tmpo4)
     1014        call initial0(nbsrf*imo*(jmo+1),tmpo3)
     1015        call initial0(nbsrf*imn*(jmn+1),tmpn3)
     1016        call initial0(nbsrf*(imn+1)*(jmn+1),tmpn4)
     1017        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,pctsrfo,tmpo3)
     1018        do l=1,nbsrf
     1019           do jo=1,jmo+1
     1020              do io=1,imo
     1021                tmpo4(io,jo,l)=tmpo3(io,jo,l)
     1022              enddo
     1023           enddo
     1024
     1025                tmpo4(imo+1,1,l)=pctsrfo(1,l)
     1026                tmpo4(imo+1,jmo+1,l)=pctsrfo(ngrido,l)
     1027            do jo=2,jmo
     1028                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
     1029            enddo
     1030c   passage a la grillle dynamique nouvelle
     1031            do jo=1,jmo+1
     1032               do io=1,imo+1
     1033                  do jn=jnord(jo)+1,jsud(jo)
     1034                     do in=iest(io)+1,iouest(io)
     1035                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
     1036                     enddo
     1037                  enddo
     1038               enddo
     1039            enddo
     1040            do jn=1,jmn+1
     1041               do in=1,imn
     1042                tmpn3(in,jn,l)=tmpn4(in,jn,l)
     1043               enddo
     1044            enddo
     1045        enddo
     1046        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,pctsrfn)
     1047
     1048        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yv1o,tmpo5)
     1049
     1050           do jo=1,jmo+1
     1051              do io=1,imo
     1052                tmpo6(io,jo)=tmpo5(io,jo)
     1053              enddo
     1054           enddo
     1055
     1056                tmpo6(imo+1,1)=yv1o(1)
     1057                tmpo6(imo+1,jmo+1)=yv1o(ngrido)
     1058            do jo=2,jmo
     1059                tmpo6(imo+1,jo)=tmpo5(1,jo)
     1060            enddo
     1061c   passage a la grillle dynamique nouvelle
     1062            do jo=1,jmo+1
     1063               do io=1,imo+1
     1064                  do jn=jnord(jo)+1,jsud(jo)
     1065                     do in=iest(io)+1,iouest(io)
     1066                        tmpn6(in,jn)=tmpo5(io,jo)
     1067                     enddo
     1068                  enddo
     1069               enddo
     1070            enddo
     1071            do jn=1,jmn+1
     1072               do in=1,imn
     1073                tmpn5(in,jn)=tmpn6(in,jn)
     1074               enddo
     1075            enddo
     1076        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yv1n)
     1077
     1078        call initial0((imo+1)*(jmo+1),tmpo6)
     1079        call initial0(imo*(jmo+1),tmpo5)
     1080        call initial0(imn*(jmn+1),tmpn5)
     1081        call initial0((imn+1)*(jmn+1),tmpn6)
     1082        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yu1o,tmpo5)
     1083
     1084           do jo=1,jmo+1
     1085              do io=1,imo
     1086                tmpo6(io,jo)=tmpo5(io,jo)
     1087              enddo
     1088           enddo
     1089
     1090                tmpo6(imo+1,1)=yu1o(1)
     1091                tmpo6(imo+1,jmo+1)=yu1o(ngrido)
     1092            do jo=2,jmo
     1093                tmpo6(imo+1,jo)=tmpo5(1,jo)
     1094            enddo
     1095c   passage a la grillle dynamique nouvelle
     1096            do jo=1,jmo+1
     1097               do io=1,imo+1
     1098                  do jn=jnord(jo)+1,jsud(jo)
     1099                     do in=iest(io)+1,iouest(io)
     1100                        tmpn6(in,jn)=tmpo5(io,jo)
     1101                     enddo
     1102                  enddo
     1103               enddo
     1104            enddo
     1105            do jn=1,jmn+1
     1106               do in=1,imn
     1107                tmpn5(in,jn)=tmpn6(in,jn)
     1108               enddo
     1109            enddo
     1110        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yu1n)
    5501111c==================================================================
    5511112        if (avant) then
    5521113c Simu directe
    553        do l=1,llm
     1114         do l=1,llm
    5541115          do ig=1,ngridn
    555              zmfu(ig,l)=mfu(ig,l)
    556              zmfd(ig,l)=mfd(ig,l)
    557              zde_u(ig,l)=de_u(ig,l)
    558              zen_u(ig,l)=en_u(ig,l)
    559              zde_d(ig,l)=de_d(ig,l)
    560              zen_d(ig,l)=en_d(ig,l)
     1116             zmfd(ig,l)=mfdn(ig,l)
     1117             zmfu(ig,l)=mfun(ig,l)
     1118             zen_d(ig,l)=en_dn(ig,l)
     1119             zde_d(ig,l)=de_dn(ig,l)
     1120             zen_u(ig,l)=en_un(ig,l)
     1121             zde_u(ig,l)=de_un(ig,l)
    5611122          enddo
    5621123       enddo
    … …  
    5651126       do l=1,llm
    5661127          do ig=1,ngridn
    567              zmfd(ig,l)=-mfu(ig,l)
    568              zmfu(ig,l)=-mfd(ig,l)
    569              zen_d(ig,l)=de_u(ig,l)
    570              zde_d(ig,l)=en_u(ig,l)
    571              zen_u(ig,l)=de_d(ig,l)
    572              zde_u(ig,l)=en_d(ig,l)
     1128             zmfd(ig,l)=-mfdn(ig,l)
     1129             zmfu(ig,l)=-mfun(ig,l)
     1130             zen_d(ig,l)=en_dn(ig,l)
     1131             zde_d(ig,l)=de_dn(ig,l)
     1132             zen_u(ig,l)=en_un(ig,l)
     1133             zde_u(ig,l)=de_un(ig,l)
    5731134          enddo
    5741135       enddo
    … …  
    5851146            zcontrole(ig)=1.
    5861147         enddo
    587 c   zmass=(max(massemn(ig,l),massemn(ig,l-1))/airefi(ig)
     1148c   zmass=(max(massemn(ig,l),massemn(ig,l-1))/airefin(ig)
    5881149         do l=2,llm
    5891150            do ig=1,ngridn
    590                zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
     1151               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefin(ig)
    5911152               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
    5921153               if(zflux.gt.0.9*zmass) then
    … …  
    6151176            enddo
    6161177         enddo
    617 
     1178        endif ! physic
    6181179
    6191180      endif ! irec=0

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

    r199 r204  
    66     I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    77     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
    8      I                   frac_impa,frac_nucl,
     8     I                   pfrac_impa,pfrac_nucl,
    99     I                   pphis,paire,dtime,itap)
    1010      USE ioipsl
    … …  
    6363c   ----------
    6464c
    65       REAL frac_impa(klon,klev)
    66       REAL frac_nucl(klon,klev)
     65      REAL pfrac_impa(klon,klev)
     66      REAL pfrac_nucl(klon,klev)
    6767c
    6868c Arguments necessaires pour les sources et puits de traceur
    … …  
    8282      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
    8383        REAL t(klon,klev)
     84      REAL frac_impa(klon,klev)
     85      REAL frac_nucl(klon,klev)
     86      REAL rain(klon)
    8487
    8588      REAL pyu1(klon),pyv1(klon)
    … …  
    9598      save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
    9699      save iadvtr,irec
     100      save frac_impa,frac_nucl,rain
    97101      save pyu1,pyv1,pftsol,ppsrf
    98102
    … …  
    133137         do k=1,klev
    134138            do i=1,klon
     139               frac_impa(i,k)=1.
     140               frac_nucl(i,k)=1.
    135141               mfu(i,k)=0.
    136142               mfd(i,k)=0.
    … …  
    144150         enddo
    145151         do i=1,klon
     152            rain(i)=0.
    146153            pyv1(i)=0.
    147154            pyu1(i)=0.
    … …  
    159166      do k=1,klev
    160167         do i=1,klon
     168            frac_impa(i,k)=frac_impa(i,k)*pfrac_impa(i,k)
     169            frac_nucl(i,k)=frac_nucl(i,k)*pfrac_nucl(i,k)
    161170            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
    162171            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
    … …  
    187196         do k=1,klev
    188197            do i=1,klon
     198c              frac_impa=frac_impa : c'est la fraction cumulee qu'on stoke
     199c              frac_nucl=frac_nucl : c'est la fraction cumulee qu'on stoke
    189200               mfu(i,k)=mfu(i,k)/dtcum
    190201               mfd(i,k)=mfd(i,k)/dtcum
    … …  
    198209         enddo
    199210         do i=1,klon
     211            rain(i)=rain(i)/dtcum
    200212            pyv1(i)=pyv1(i)/dtcum
    201213            pyu1(i)=pyu1(i)/dtcum
    … …  
    226238
    227239ccccc
     240      print*,'AVANT ECRITURE'
    228241         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
    229242         CALL histwrite(physid,"t",itap,zx_tmp_3d,
    230243     .                                   iim*(jjm+1)*klev,ndex)
     244      print*,'APRES ECRITURE'
    231245
    232246         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
    … …  
    279293         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
    280294      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
     295     .                                   iim*(jjm+1),ndex)
     296
     297        CALL gr_fi_ecrit(1,klon,iim,jjm+1, rain, zx_tmp_2d)
     298      CALL histwrite(physid,"rain",itap,zx_tmp_2d,
    281299     .                                   iim*(jjm+1),ndex)
    282300

  • 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.