Ignore:
Timestamp:
Mar 20, 2014, 10:57:19 AM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1920:1997 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phy1d/1DUTILS.h

    r1921 r1999  
    44c
    55c
    6       SUBROUTINE conf_unicol( tapedef )
     6      SUBROUTINE conf_unicol
    77c
    88#ifdef CPP_IOIPSL
    … …  
    1515c-----------------------------------------------------------------------
    1616c     Auteurs :   A. Lahellec  .
    17 c
    18 c     Arguments :
    19 c
    20 c     tapedef   :
    21 
    22        INTEGER tapedef
    2317c
    2418c   Declarations :
    … …  
    367361c   Variables locales pour NetCDF:
    368362c   ------------------------------
    369       INTEGER nid, nvarid
    370       INTEGER idim_s
    371       INTEGER ierr, ierr_file
    372363      INTEGER iq
    373364      INTEGER length
    … …  
    378369      character*80 abort_message
    379370      LOGICAL found
    380 c
    381       INTEGER nb
    382371
    383372      modname = 'dyn1deta0 : '
    … …  
    508497c   ----------
    509498      CHARACTER*(*) fichnom
    510       REAL time
    511499cAl1 plev tronque pour .nc mais plev(klev+1):=0
    512500      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
    … …  
    520508c   Variables locales pour NetCDF:
    521509c   ------------------------------
    522       INTEGER nid, nvarid
    523       INTEGER idim_s
    524       INTEGER ierr, ierr_file
     510      INTEGER nid
     511      INTEGER ierr
    525512      INTEGER iq,l
    526513      INTEGER length
    … …  
    535522      DATA nb / 0 /
    536523
    537       REAL zan0,zjulian,hours
    538       INTEGER yyears0,jjour0, mmois0
    539       character*30 unites
    540 
    541 cDbg
    542524      CALL open_restartphy(fichnom)
    543525      print*,'redm1 ',fichnom,klon,klev,nqtot
    … …  
    550532      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
    551533      IF (ierr .NE. NF_NOERR) THEN
    552          PRINT*, "Pb. d ouverture "//fichnom
    553          CALL abort
     534         abort_message="Pb. d ouverture "//fichnom
     535         CALL abort_gcm('Modele 1D',abort_message,1)
    554536      ENDIF
    555537
    … …  
    661643!   traitement des point normaux
    662644         DO j=2,jm-1
    663             ig=2+(j-2)*(im-1)
     645            ig=2+(j-2)*(im-1)
    664646            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
    665             pdyn(im,j,ifield)=pdyn(1,j,ifield)
     647            pdyn(im,j,ifield)=pdyn(1,j,ifield)
    666648         ENDDO
    667649      ENDDO
    … …  
    683665!         ierr    = severity of situation ( = 0 normal )
    684666 
    685       character*20 modname
     667      character(len=*) modname
    686668      integer ierr
    687       character*80 message
     669      character(len=*) message
    688670 
    689671      write(*,*) 'in abort_gcm'
    … …  
    764746      RETURN
    765747      END
    766       subroutine wrgradsfi(if,nl,field,name,titlevar)
    767       implicit none
    768  
    769 !   Declarations
    770  
    771 #include "gradsdef.h"
    772  
    773 !   arguments
    774       integer if,nl
    775       real field(imx*jmx*lmx)
    776       character*10 name,file
    777       character*10 titlevar
    778  
    779 !   local
    780  
    781       integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
    782  
    783       logical writectl
    784  
    785  
    786       writectl=.false.
    787  
    788 !     print*,if,iid(if),jid(if),ifd(if),jfd(if)
    789       iii=iid(if)
    790       iji=jid(if)
    791       iif=ifd(if)
    792       ijf=jfd(if)
    793       im=iif-iii+1
    794       jm=ijf-iji+1
    795       lm=lmd(if)
    796 
    797 
    798 !     print*,'im,jm,lm,name,firsttime(if)'
    799 !     print*,im,jm,lm,name,firsttime(if)
    800  
    801       if(firsttime(if)) then
    802          if(name.eq.var(1,if)) then
    803             firsttime(if)=.false.
    804             ivar(if)=1
    805          print*,'fin de l initialiation de l ecriture du fichier'
    806          print*,file
    807            print*,'fichier no: ',if
    808            print*,'unit ',unit(if)
    809            print*,'nvar  ',nvar(if)
    810            print*,'vars ',(var(iv,if),iv=1,nvar(if))
    811          else
    812             ivar(if)=ivar(if)+1
    813             nvar(if)=ivar(if)
    814             var(ivar(if),if)=name
    815             tvar(ivar(if),if)=trim(titlevar)
    816             nld(ivar(if),if)=nl
    817             print*,'initialisation ecriture de ',var(ivar(if),if)
    818             print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
    819          endif
    820          writectl=.true.
    821          itime(if)=1
    822       else
    823          ivar(if)=mod(ivar(if),nvar(if))+1
    824          if (ivar(if).eq.nvar(if)) then
    825             writectl=.true.
    826             itime(if)=itime(if)+1
    827          endif
    828  
    829          if(var(ivar(if),if).ne.name) then
    830            print*,'Il faut stoker la meme succession de champs a chaque'
    831            print*,'pas de temps'
    832            print*,'fichier no: ',if
    833            print*,'unit ',unit(if)
    834            print*,'nvar  ',nvar(if)
    835            print*,'vars ',(var(iv,if),iv=1,nvar(if))
    836  
    837            stop
    838          endif
    839       endif
    840  
    841 !     print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
    842 !     print*,ivar(if),nvar(if),var(ivar(if),if),writectl
    843       do l=1,nl
    844          irec(if)=irec(if)+1
    845 !        print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf,
    846 !    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
    847 !    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
    848          write(unit(if)+1,rec=irec(if))
    849      s   ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i)
    850      s   ,i=iii,iif),j=iji,ijf)
    851       enddo
    852       if (writectl) then
    853  
    854       file=fichier(if)
    855 !   WARNING! on reecrase le fichier .ctl a chaque ecriture
    856       open(unit(if),file=trim(file)//'.ctl',
    857      &         form='formatted',status='unknown')
    858       write(unit(if),'(a5,1x,a40)')
    859      &       'DSET ','^'//trim(file)//'.dat'
    860  
    861       write(unit(if),'(a12)') 'UNDEF 1.0E30'
    862       write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if)
    863       call formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF')
    864       call formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF')
    865       call formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF')
    866       write(unit(if),'(a4,i10,a30)')
    867      &       'TDEF ',itime(if),' LINEAR 07AUG1998 30MN '
    868       write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if)
    869       do iv=1,nvar(if)
    870 !        print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
    871 !        print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
    872          write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if)
    873      &     ,99,tvar(iv,if)
    874       enddo
    875       write(unit(if),'(a7)') 'ENDVARS'
    876 !
    877 1000  format(a5,3x,i4,i3,1x,a39)
    878  
    879       close(unit(if))
    880  
    881       endif ! writectl
    882  
    883       return
    884  
    885       END
    886  
    887       subroutine inigrads(if,im
    888      s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
    889      s  ,dt,file,titlel)
    890  
    891  
    892       implicit none
    893  
    894       integer if,im,jm,lm,i,j,l
    895       real x(im),y(jm),z(lm),fx,fy,fz,dt
    896       real xmin,xmax,ymin,ymax
    897       integer nf
    898  
    899       character file*10,titlel*40
    900  
    901 #include "gradsdef.h"
    902  
    903       data unit/24,32,34,36,38,40,42,44,46,48/
    904       data nf/0/
    905  
    906       if (if.le.nf) stop'verifier les appels a inigrads'
    907  
    908       print*,'Entree dans inigrads'
    909  
    910       nf=if
    911       title(if)=titlel
    912       ivar(if)=0
    913  
    914       fichier(if)=trim(file)
    915  
    916       firsttime(if)=.true.
    917       dtime(if)=dt
    918  
    919       iid(if)=1
    920       ifd(if)=im
    921       imd(if)=im
    922       do i=1,im
    923          xd(i,if)=x(i)*fx
    924          if(xd(i,if).lt.xmin) iid(if)=i+1
    925          if(xd(i,if).le.xmax) ifd(if)=i
    926       enddo
    927       print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
    928  
    929       jid(if)=1
    930       jfd(if)=jm
    931       jmd(if)=jm
    932       do j=1,jm
    933          yd(j,if)=y(j)*fy
    934          if(yd(j,if).gt.ymax) jid(if)=j+1
    935          if(yd(j,if).ge.ymin) jfd(if)=j
    936       enddo
    937       print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
    938 
    939       print*,'Open de dat'
    940       print*,'file=',file
    941       print*,'fichier(if)=',fichier(if)
    942  
    943       print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
    944       print*,trim(file)//'.dat'
    945  
    946       OPEN (unit(if)+1,FILE=trim(file)//'.dat',
    947      s   FORM='UNFORMATTED',
    948      s   ACCESS='DIRECT'
    949      s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
    950  
    951       print*,'Open de dat ok'
    952  
    953       lmd(if)=lm
    954       do l=1,lm
    955          zd(l,if)=z(l)*fz
    956       enddo
    957  
    958       irec(if)=0
    959 !CR
    960 !      print*,if,imd(if),jmd(if),lmd(if)
    961 !      print*,'if,imd(if),jmd(if),lmd(if)'
    962  
    963       return
    964       end
     748 
    965749      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
    966750      IMPLICIT NONE
    … …  
    992776      DO ifield=1,nfield
    993777         DO j=2,jm-1
    994             ig=2+(j-2)*(im-1)
     778            ig=2+(j-2)*(im-1)
    995779            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
    996780         ENDDO
    … …  
    1151935
    1152936!======================================================================
    1153        SUBROUTINE read_tsurf1d(knon,knindex,sst_out)
     937       SUBROUTINE read_tsurf1d(knon,sst_out)
    1154938
    1155939! This subroutine specifies the surface temperature to be used in 1D simulations
    … …  
    1158942
    1159943      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
    1160       INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
    1161944      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
    1162945
    … …  
    12201003
    12211004       SUBROUTINE advect_va(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
    1222      !                q,temp,u,v,
    1223      !            play,plev)
     1005     s                q,temp,u,v,play)
    12241006!itlmd
    12251007!----------------------------------------------------------------------
    … …  
    12371019        real  q(llm,3),temp(llm)
    12381020        real  u(llm),v(llm)
    1239         real  play(llm),plev(llm+1)
     1021        real  play(llm)
    12401022! interne
    12411023        integer l
    … …  
    13231105        real dph(llm),dqdp(llm),dtdp(llm)
    13241106! interne
    1325         integer l,k
    1326         real alpha,omdn,omup
     1107        integer k
     1108        real omdn,omup
    13271109
    13281110!        dudp=0.
    … …  
    14031185      character*80 fich_toga
    14041186
    1405       integer no,l,k,ip
    1406       real riy,rim,rid,rih,bid
     1187      integer k,ip
     1188      real bid
    14071189
    14081190      integer iy,im,id,ih
    … …  
    14221204
    14231205       do k = 1, nlev_toga
    1424          read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip) 
     1206         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)
    14251207     :       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)
    14261208     :       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
    … …  
    14431225
    14441226  223 format(4i3,6f8.2)
    1445   226 format(f7.1,1x,10f8.2)
    1446   227 format(f7.1,1x,1p,4e11.3)
    14471227  230 format(6f9.3,4e11.3)
    14481228
    … …  
    14621242      character*80 fich_sandu
    14631243
    1464       integer no,l,k,ip
    1465       real riy,rim,rid,rih,bid
    1466 
     1244      integer ip
    14671245      integer iy,im,id,ih
    14681246
    1469        real plev_min
    1470 
    1471        plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
     1247      real plev_min
     1248
     1249      print*,'nlev_sandu',nlev_sandu
     1250      plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
    14721251
    14731252      open(21,file=trim(fich_sandu),form='formatted')
    … …  
    14821261
    14831262  223 format(4i3,f8.2)
    1484   226 format(f7.1,1x,10f8.2)
    1485   227 format(f7.1,1x,1p,4e11.3)
    1486   230 format(6f9.3,4e11.3)
    14871263
    14881264          return
    … …  
    15041280      character*80 fich_astex
    15051281
    1506       integer no,l,k,ip
    1507       real riy,rim,rid,rih,bid
    1508 
     1282      integer ip
    15091283      integer iy,im,id,ih
    15101284
    15111285       real plev_min
    15121286
     1287      print*,'nlev_astex',nlev_astex
    15131288       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
    15141289
    … …  
    15281303
    15291304  223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
    1530   226 format(f7.1,1x,10f8.2)
    1531   227 format(f7.1,1x,1p,4e11.3)
    1532   230 format(6f9.3,4e11.3)
    15331305
    15341306          return
    … …  
    15511323      character*80 :: fich_twpice
    15521324      real*8 time(ntime)
    1553       real*8 lat, lon, alt, phis       
     1325      real*8 lat, lon, alt, phis
    15541326      real*8 lev(nlevel)
    15551327      real*8 plev(nlevel,ntime)
    … …  
    15611333      real*8 T_adv_h(nlevel,ntime)
    15621334      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
    1563       real*8 q_adv_v(nlevel,ntime)     
     1335      real*8 q_adv_v(nlevel,ntime)
    15641336      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
    15651337      real*8 s_adv_v(nlevel,ntime)
    … …  
    19761748         integer ierr
    19771749
    1978          integer i
    19791750         integer timevar,levvar
    19801751         integer timelen,levlen
    … …  
    20501821       real omega_mod(llm),o3mmr_mod(llm)
    20511822
    2052        integer l,k,k1,k2,kp
    2053        real aa,frac,frac1,frac2,fact
     1823       integer l,k,k1,k2
     1824       real frac,frac1,frac2,fact
    20541825
    20551826       do l = 1, llm
    … …  
    21681939       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
    21691940
    2170        integer l,k,k1,k2,kp
    2171        real aa,frac,frac1,frac2,fact
     1941       integer l,k,k1,k2
     1942       real frac,frac1,frac2,fact
    21721943
    21731944       do l = 1, llm
    … …  
    24442215        real ts_prof
    24452216! local:
    2446         integer it_sandu1, it_sandu2,k
     2217        integer it_sandu1, it_sandu2
    24472218        real timeit,time_sandu1,time_sandu2,frac
    24482219! Check that initial day of the simulation consistent with SANDU period:
    … …  
    25112282      character*80 fich_armcu
    25122283
    2513       integer no,l,k,ip
    2514       real riy,rim,rid,rih,bid
     2284      integer ip
    25152285
    25162286      integer iy,im,id,ih,in
     2287
     2288      print*,'nlev_armcu',nlev_armcu
    25172289
    25182290      open(21,file=trim(fich_armcu),form='formatted')
    … …  
    25292301
    25302302  223 format(5i3,5f8.3)
    2531   226 format(f7.1,1x,10f8.2)
    2532   227 format(f7.1,1x,1p,4e11.3)
    2533   230 format(6f9.3,4e11.3)
    25342303
    25352304          return
    … …  
    25712340       real hq_mod(llm),vq_mod(llm)
    25722341 
    2573        integer l,k,k1,k2,kp
    2574        real aa,frac,frac1,frac2,fact
     2342       integer l,k,k1,k2
     2343       real frac,frac1,frac2,fact
    25752344 
    25762345       do l = 1, llm
    … …  
    26842453        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
    26852454! local:
    2686         integer it_astex1, it_astex2,k
     2455        integer it_astex1, it_astex2
    26872456        real timeit,time_astex1,time_astex2,frac
    26882457
    … …  
    29682737
    29692738!=====================================================================
    2970       subroutine readprofiles(nlev_max,kmax,height,
     2739      subroutine readprofiles(nlev_max,kmax,ntrac,height,
    29712740     .           thlprof,qtprof,uprof,
    29722741     .           vprof,e12prof,ugprof,vgprof,
    29732742     .           wfls,dqtdxls,dqtdyls,dqtdtls,
    2974      .           thlpcar)
     2743     .           thlpcar,tracer,nt1,nt2)
    29752744      implicit none
    29762745
    2977         integer nlev_max,kmax,kmax2
     2746        integer nlev_max,kmax,kmax2,ntrac
    29782747        logical :: llesread = .true.
    29792748
    … …  
    29822751     .       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),
    29832752     .       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),
    2984      .           thlpcar(nlev_max)
     2753     .           thlpcar(nlev_max),tracer(nlev_max,ntrac)
    29852754
    29862755        integer, parameter :: ilesfile=1
    2987         integer :: ierr,irad,imax,jtot,k
    2988         logical :: lmoist,lcoriol,ltimedep
    2989         real :: xsize,ysize
    2990         real :: ustin,wsvsurf,timerad
    2991         character(80) :: chmess
     2756        integer :: ierr,k,itrac,nt1,nt2
    29922757
    29932758        if(.not.(llesread)) return
    … …  
    30162781        close(ilesfile)
    30172782
     2783       open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
     2784        if (ierr /= 0) then
     2785            print*,'WARNING : trac.inp does not exist'
     2786        else
     2787        read (ilesfile,*) kmax2,nt1,nt2
     2788        if (nt2>ntrac) then
     2789          stop'Augmenter le nombre de traceurs dans traceur.def'
     2790        endif
     2791        if (kmax .ne. kmax2) then
     2792          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
     2793          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
     2794          stop 'lecture profiles'
     2795        endif
     2796        do k=1,kmax
     2797          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
     2798        end do
     2799        close(ilesfile)
     2800        endif
     2801
    30182802        return
    30192803        end
    … …  
    30242808      implicit none
    30252809
    3026         integer nlev_max,kmax,kmax2
     2810        integer nlev_max,kmax
    30272811        logical :: llesread = .true.
    30282812
    … …  
    30332817
    30342818        integer, parameter :: ilesfile=1
    3035         integer :: ierr,irad,imax,jtot,k
    3036         logical :: lmoist,lcoriol,ltimedep
    3037         real :: xsize,ysize
    3038         real :: ustin,wsvsurf,timerad
    3039         character(80) :: chmess
     2819        integer :: k,ierr
    30402820
    30412821        if(.not.(llesread)) return
    … …  
    30602840      implicit none
    30612841
    3062         integer nlev_max,kmax,kmax2
     2842        integer nlev_max,kmax
    30632843        logical :: llesread = .true.
    30642844
    … …  
    30692849
    30702850        integer, parameter :: ilesfile=1
    3071         integer :: ierr,irad,imax,jtot,k
    3072         logical :: lmoist,lcoriol,ltimedep
    3073         real :: xsize,ysize
    3074         real :: ustin,wsvsurf,timerad
    3075         character(80) :: chmess
     2851        integer :: ierr,k
    30762852
    30772853        if(.not.(llesread)) return
    … …  
    30982874      implicit none
    30992875
    3100         integer nlev_max,kmax,kmax2
     2876        integer nlev_max,kmax
    31012877        logical :: llesread = .true.
    31022878
    … …  
    31082884        integer, parameter :: ilesfile=1
    31092885        integer, parameter :: ifile=2
    3110         integer :: ierr,irad,imax,jtot,k
    3111         logical :: lmoist,lcoriol,ltimedep
    3112         real :: xsize,ysize
    3113         real :: ustin,wsvsurf,timerad
    3114         character(80) :: chmess
     2886        integer :: ierr,jtot,k
    31152887
    31162888        if(.not.(llesread)) return
    … …  
    31632935
    31642936      integer ntime,nlevel
    3165       integer l,k
    31662937      character*80 :: fich_amma
    3167       real*8 time(ntime)
    3168       real*8 zz(nlevel)
     2938      real*8 zz(nlevel)
    31692939
    31702940      real*8 temp(nlevel),pp(nlevel)
    … …  
    31732943      real*8 dw(nlevel,ntime)
    31742944      real*8 dt(nlevel,ntime)
    3175       real*8 dq(nlevel,ntime)   
     2945      real*8 dq(nlevel,ntime)
    31762946      real*8 flat(ntime),sens(ntime)
    31772947
    … …  
    35033273
    35043274      integer ntime,nlevel
    3505       integer l,k
    35063275      character*80 :: fich_fire
    3507       real*8 time(ntime)
    3508       real*8 zz(nlevel)
     3276      real*8 zz(nlevel)
    35093277
    35103278      real*8 thl(nlevel)
    … …  
    35133281      real*8 ug(nlevel,ntime),vg(nlevel,ntime),wls(nlevel,ntime)
    35143282      real*8 dqtdx(nlevel,ntime),dqtdy(nlevel,ntime)
    3515       real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime) 
     3283      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
    35163284
    35173285      integer nid, ierr
Note: See TracChangeset for help on using the changeset viewer.