Ignore:
Timestamp:
Jun 22, 2004, 1:45:36 PM (20 years ago)
Author:
lmdzadmin
Message:

Convergence avec la version d'Olivia Coindreau incluant:

  • le offline
  • les thermiques
  • mellor & yamada dans la couche limite

LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/read_pstoke0.F

    r524 r541  
    77     .   zrec,zkon,zkev,airefi,phisfi,
    88     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
     9     .   fm_therm,en_therm,
    910     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
     11
     12C******************************************************************************
     13C  Frederic HOURDIN, Abderrahmane IDELKADI
     14C Lecture des parametres physique stockes online necessaires pour
     15C recalculer offline le transport des traceurs sur la meme grille que online
     16C A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
     17C******************************************************************************
    1018
    1119
    … …  
    2634#include "dimphy.h"
    2735         
    28           integer*4 kon,kev,zkon,zkev
     36          integer kon,kev,zkon,zkev
    2937          parameter(kon=iim*(jjm-1)+2,kev=llm)
    30           REAL*4 phisfi(kon)
    31           REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
    32 
    33           REAL*4 mfu(kon,kev), mfd(kon,kev)
    34           REAL*4 en_u(kon,kev), de_u(kon,kev)
    35           REAL*4 en_d(kon,kev), de_d(kon,kev)
    36           REAL*4 coefh(kon,kev)
    37                 REAL*4 t(kon,kev)
    38 
    39           REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
    40           REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
    41           REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
    42           REAL*4 coefh2(iim,jjm+1,kev)
    43                 REAL*4 t2(iim,jjm+1,kev)
    44 
    45           REAL*4 pl(kev)
     38          REAL phisfi(kon)
     39          REAL phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
     40
     41          REAL mfu(kon,kev), mfd(kon,kev)
     42          REAL en_u(kon,kev), de_u(kon,kev)
     43          REAL en_d(kon,kev), de_d(kon,kev)
     44          REAL coefh(kon,kev)
     45
     46c abd 25 11 02
     47c Thermiques
     48         REAL fm_therm(kon,kev),en_therm(kon,kev)
     49                REAL t(kon,kev)
     50
     51          REAL mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
     52          REAL en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
     53          REAL en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
     54          REAL coefh2(iim,jjm+1,kev)
     55                REAL t2(iim,jjm+1,kev)
     56c Thermiques
     57         REAL fm_therm2(iim,jjm+1,kev)
     58         REAL en_therm2(iim,jjm+1,kev)       
     59
     60          REAL pl(kev)
    4661          integer irec
    47           integer*4 xid,yid,zid,tid
    48           integer*4 zrec,zim,zjm
    49           integer*4 ncrec,nckon,nckev,ncim,ncjm
    50 
    51           real*4 airefi(kon)
    52           character namedim
     62          integer xid,yid,zid,tid
     63          integer zrec,zim,zjm
     64          integer ncrec,nckon,nckev,ncim,ncjm
     65
     66          real airefi(kon)
     67          character*20 namedim
    5368
    5469c  !! attention !!
    … …  
    5671c dim de phis??
    5772
    58           REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
    59           REAL*4 frac_impa2(iim,jjm+1,kev),
     73          REAL frac_impa(kon,kev), frac_nucl(kon,kev)
     74          REAL frac_impa2(iim,jjm+1,kev),
    6075     .     frac_nucl2(iim,jjm+1,kev)
    61           REAL*4 pyu1(kon), pyv1(kon)
    62           REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
    63           REAL*4 ftsol(kon,nbsrf)
    64           REAL*4 psrf(kon,nbsrf)
    65           REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
    66           REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
    67           REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
     76          REAL pyu1(kon), pyv1(kon)
     77          REAL pyu12(iim,jjm+1), pyv12(iim,jjm+1)
     78          REAL ftsol(kon,nbsrf)
     79          REAL psrf(kon,nbsrf)
     80          REAL ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
     81          REAL psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
     82          REAL ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
    6883     .     ftsol32(iim,jjm+1),
    6984     .     ftsol42(iim,jjm+1)
    70           REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
     85          REAL psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
    7186     .     psrf42(iim,jjm+1)
    7287       
    … …  
    7691                integer varidt
    7792          integer varidend,varidded,varidch,varidfi,varidfn
     93c therm
     94          integer varidfmth,varidenth
    7895          integer varidyu1,varidyv1,varidpl,varidai,varididvt
    7996          integer varidfts1,varidfts2,varidfts3,varidfts4
    … …  
    8299                save varidt
    83100          save varidend,varidded,varidch,varidfi,varidfn
     101c therm
     102           save varidfmth,varidenth
    84103          save varidyu1,varidyv1,varidpl,varidai,varididvt
    85104          save varidfts1,varidfts2,varidfts3,varidfts4
    … …  
    112131            print*,'ncidp,varidai',ncidp,varidai
    113132
     133                varidt=NCVID(ncidp,'t',rcode)
     134                print*,'ncidp,varidt',ncidp,varidt
     135
    114136            varidmfu=NCVID(ncidp,'mfu',rcode)
    115137            print*,'ncidp,varidmfu',ncidp,varidmfu
    116138
    117                 varidt=NCVID(ncidp,'t',rcode)
    118                 print*,'ncidp,varidt',ncidp,varidt
    119 
    120139            varidmfd=NCVID(ncidp,'mfd',rcode)
    121140            print*,'ncidp,varidmfd',ncidp,varidmfd
    … …  
    135154            varidch=NCVID(ncidp,'coefh',rcode)
    136155            print*,'ncidp,varidch',ncidp,varidch
     156
     157c Thermiques
     158            varidfmth=NCVID(ncidp,'fm_th',rcode)
     159            print*,'ncidp,varidfmth',ncidp,varidfmth
     160
     161            varidenth=NCVID(ncidp,'en_th',rcode)
     162            print*,'ncidp,varidenth',ncidp,varidenth
    137163       
    138164            varidfi=NCVID(ncidp,'frac_impa',rcode)
    … …  
    216242
    217243c
     244C**** Geopotentiel au sol ***************************************
    218245c phis
    219       status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
     246#ifdef NC_DOUBLE
     247      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
     248#else
     249        status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
     250#endif
    220251      call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
    221252
     253C**** Aires des mails aux sol ************************************
    222254c aire
    223       status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
     255#ifdef NC_DOUBLE
     256      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
     257#else
     258        status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
     259#endif
    224260      call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
    225261      else
    … …  
    244280      count(4)=1
    245281
    246 c frac_impa
    247 
    248       status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
    249       call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
    250 
    251 c frac_nucl
    252 
    253       status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
    254       call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
     282C**** Temperature ********************************************
     283cA FAIRE : Es-ce necessaire ?
    255284
    256285c abder t
    257       status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
     286#ifdef NC_DOUBLE
     287      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
     288#else
     289        status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
     290#endif
    258291      call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
    259292
     293C**** Flux pour la convection (Tiedtk) ********************************************
    260294c mfu
    261       status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
     295#ifdef NC_DOUBLE
     296      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
     297#else
     298        status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
     299#endif
    262300      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
    263301
    264302c mfd
    265       status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
     303#ifdef NC_DOUBLE
     304      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
     305#else
     306        status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
     307#endif
    266308      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
    267309
    268310c en_u
    269       status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
     311#ifdef NC_DOUBLE
     312      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
     313#else
     314        status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
     315#endif
    270316      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
    271317
    272318c de_u
    273       status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
     319#ifdef NC_DOUBLE
     320      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
     321#else
     322        status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
     323#endif
    274324      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
    275325
    276326c en_d
    277       status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
     327#ifdef NC_DOUBLE
     328      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
     329#else
     330        status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
     331#endif
    278332      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
    279333
    280334c de_d
    281       status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
     335#ifdef NC_DOUBLE
     336      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
     337#else
     338        status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
     339#endif
    282340      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
    283341
     342C**** Coefficient de mellange turbulent *******************************************
    284343c coefh
    285344        print*,'LECTURE de coefh a irec =',irec
    286        status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
     345#ifdef NC_DOUBLE
     346      status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
     347#else
     348        status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
     349#endif
    287350       call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
     351c      call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
     352c      call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ   ')
     353
     354C**** Flux ascendants et entrant dans le thermique **********************************
     355cThermiques
     356       print*,'LECTURE de fm_therm a irec =',irec
     357#ifdef NC_DOUBLE
     358      status=NF_GET_VARA_DOUBLE(ncidp,varidfmth,start,
     359     .                         count,fm_therm2)
     360#else
     361       status=NF_GET_VARA_REAL(ncidp,varidfmth,start,
     362     .                         count,fm_therm2)
     363#endif
     364       call gr_ecrit_fi(kev,kon,iim,jjm+1,fm_therm2,fm_therm)
     365       print*,'LECTURE de en_therm a irec =',irec
     366#ifdef NC_DOUBLE
     367      status=NF_GET_VARA_DOUBLE(ncidp,varidenth,start,
     368     .                          count,en_therm2)
     369#else
     370       status=NF_GET_VARA_REAL(ncidp,varidenth,start,
     371     .                          count,en_therm2)
     372#endif
     373       call gr_ecrit_fi(kev,kon,iim,jjm+1,en_therm2,en_therm)
     374
     375C**** Coefficients de lessivage *******************************************
     376c frac_impa
     377#ifdef NC_DOUBLE
     378      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
     379#else
     380        status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
     381#endif
     382      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
     383
     384c frac_nucl
     385
     386#ifdef NC_DOUBLE
     387      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
     388#else
     389        status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
     390#endif
     391      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
     392
     393C**** Vents aux sol ********************************************
    288394
    289395      start(3)=irec
    … …  
    294400c pyu1
    295401        print*,'LECTURE de yu1 a irec =',irec
    296       status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
     402#ifdef NC_DOUBLE
     403      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
     404#else
     405        status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
     406#endif
    297407      call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
    298408
    299409c pyv1
    300410        print*,'LECTURE de yv1 a irec =',irec
    301       status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
     411#ifdef NC_DOUBLE
     412      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
     413#else
     414        status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
     415#endif
    302416      call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
    303417
     418C**** Temerature au sol ********************************************
    304419c ftsol1
    305420        print*,'LECTURE de ftsol1 a irec =',irec
     421#ifdef NC_DOUBLE
     422      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
     423#else
    306424      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
     425#endif
    307426       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
    308427
    309428c ftsol2
    310429        print*,'LECTURE de ftsol2 a irec =',irec
     430#ifdef NC_DOUBLE
     431      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
     432#else
    311433      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
     434#endif
    312435      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
    313436
    314437c ftsol3
    315438         print*,'LECTURE de ftsol3 a irec =',irec
     439#ifdef NC_DOUBLE
     440      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
     441#else
    316442      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
     443#endif
    317444      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
    318445
    319446c ftsol4
     447#ifdef NC_DOUBLE
     448      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
     449#else
    320450      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
     451#endif
    321452      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
    322453
     454C**** Nature sol ********************************************
    323455c psrf1
     456#ifdef NC_DOUBLE
     457      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
     458#else
    324459      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
     460#endif
    325461c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
    326462      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
    327463
    328464c psrf2
     465#ifdef NC_DOUBLE
     466      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
     467#else
    329468      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
     469#endif
    330470c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
    331471      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
    332472
    333473c psrf3
     474#ifdef NC_DOUBLE
     475      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
     476#else
    334477      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
     478#endif
    335479      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
    336480
    337481c psrf4
     482#ifdef NC_DOUBLE
     483      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
     484#else
    338485      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
     486#endif
    339487      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
    340488       
    … …  
    344492        psrf(i,2) = psrf2(i)
    345493        psrf(i,3) = psrf3(i)
     494c test abderr
     495c       print*,'Dans read_pstoke psrf3 =',psrf3(i),i
    346496        psrf(i,4) = psrf4(i)
    347497 
Note: See TracChangeset for help on using the changeset viewer.