Ignore:
Timestamp:
Apr 13, 2001, 12:44:53 PM (24 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/dyn3d
Files:
4 deleted
5 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
Note: See TracChangeset for help on using the changeset viewer.