Ignore:
Timestamp:
Jul 10, 2002, 5:07:19 PM (22 years ago)
Author:
lmdzadmin
Message:

Prise en compte du fichier de trait de cote (si il existe) et du masque
correspondant dans les parametrisation de FLott
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r359 r370  
    160160      ENDDO
    161161      !
    162       varname = 'relief'
    163       ! This line needs to be replaced by a call to restget to get the values in the restart file
    164       orog(:,:) = 0.0
    165        CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0 ,
    166      , jjm ,rlonu,rlatv , interbar )
    167       !
    168       WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
    169 !      WRITE(*,'(49I1)') INT(orog(:,:))
    170       !
    171       varname = 'rugosite'
    172       ! This line needs to be replaced by a call to restget to get the values in the restart file
    173       rugo(:,:) = 0.0
    174        CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0 ,
    175      , jjm, rlonu,rlatv , interbar )
    176       !
    177       WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite'
    178 !      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
    179       !
    180       varname = 'masque'
    181       ! This line needs to be replaced by a call to restget to get the values in the restart file
    182       masque(:,:) = 0.0
    183      
    184        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0,
    185      , jjm ,rlonu,rlatv , interbar )
    186 !      masque = nint(masque)
    187       !
    188       WRITE(*,*) 'MASQUE construit : Masque'
    189       WRITE(*,'(97I1)') nINT(masque(:,:))
    190       !
    191       !
    192 
    193 
    194 C
    195 C on initialise les sous surfaces
    196 C
    197       pctsrf=0.
    198       !cree le masque a partir du fichier relief
    199       call gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
    200       WHERE (zmasq(1 : klon) .LT. EPSFRA)
    201           zmasq(1 : klon) = 0.
    202       END WHERE
    203       WHERE (1. - zmasq(1 : klon) .LT. EPSFRA)
    204           zmasq(1 : klon) = 1.
    205       END WHERE
    206 c
    207       varname = 'psol'
    208       psol(:,:) = 0.0
    209       CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0 ,
    210      , jjm ,rlonu,rlatv , interbar )
    211       !
    212       !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM
    213       !  anyway.
    214       !
    215 !      WRITE(*,*) 'PSOL :', psol(10,20)
    216 !      WRITE(*,*) ap(:), bp(:)
    217       CALL pression(ip1jmp1, ap, bp, psol, p3d)
    218 !      WRITE(*,*) 'P3D :', p3d(10,20,:)
    219       CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, workvar)
    220 !      WRITE(*,*) 'PK:', pk(10,20,:)
    221       !
    222       !
    223       !
    224       prefkap =  preff  ** kappa
    225 !      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
    226       DO l = 1, llm
    227         DO j=1,jjp1
    228           DO i =1, iip1
    229             pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    230            ENDDO
    231         ENDDO
    232       ENDDO
    233       !
    234 !      WRITE(*,*) 'PLS :', pls(10,20,:)
    235       !
    236       varname = 'surfgeo'
    237       phis(:,:) = 0.0
    238       CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0 ,
    239      , jjm ,rlonu,rlatv, interbar )
    240       !
    241       varname = 'u'
    242       uvent(:,:,:) = 0.0
    243       CALL startget(varname, iip1, jjp1, rlonu, rlatu, llm, pls,
    244      . workvar, uvent, 0.0, jjm ,rlonv, rlatv, interbar )
    245       ! 
    246       varname = 'v'
    247       vvent(:,:,:) = 0.0
    248       CALL startget(varname, iip1, jjm, rlonv, rlatv, llm, pls,
    249      . workvar, vvent, 0.0, jjp1, rlonu, rlatu, interbar )
    250       !
    251       varname = 't'
    252       t3d(:,:,:) = 0.0
    253       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    254      . workvar, t3d, 0.0 , jjm, rlonu, rlatv , interbar )
    255       !
    256       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
    257      .                          maxval(t3d(:,:,:))
    258       varname = 'tpot'
    259       tpot(:,:,:) = 0.0
    260       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    261      . pk, tpot, 0.0 , jjm, rlonu, rlatv , interbar )
    262       !
    263       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
    264      .                          maxval(t3d(:,:,:))
    265       WRITE(*,*) 'PLS min,max:',minval(pls(:,:,:)),
    266      .                          maxval(pls(:,:,:))
    267       DO l = 1, llm
    268         DO j=1,jjp1
    269           DO i =1, iip1-1
    270            qsat(i,j,l) = q_sat(t3d(i,j,l),pls(i,j,l)/100. )
    271           ENDDO
    272           qsat(iip1,j,l) = qsat(1,j,l)
    273         ENDDO
    274       ENDDO
    275       WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
    276      .                           maxval(qsat(:,:,:))
    277       !
    278       WRITE(*,*) 'QSAT :', qsat(10,20,:)
    279       !
    280       varname = 'q'
    281       qd(:,:,:) = 0.0
    282       q3d(:,:,:,:) = 0.0
    283       WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
    284      .                           maxval(qsat(:,:,:))
    285       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    286      . qsat, qd, 0.0, jjm, rlonu, rlatv , interbar )
    287       q3d(:,:,:,1) = qd(:,:,:)
    288       !
    289       varname = 'tsol'
    290       ! This line needs to be replaced by a call to restget to get the values in the restart file
    291       tsol(:) = 0.0
    292       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0,
    293      .    jjm, rlonu, rlatv , interbar )
    294       !
    295       WRITE(*,*) 'TSOL construit :'
    296 !      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
    297       !
    298       varname = 'qsol'
    299       qsol(:) = 0.0
    300       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0,
    301      .   jjm, rlonu, rlatv , interbar )
    302       !
    303       varname = 'snow'
    304       sn(:) = 0.0
    305       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0,
    306      .    jjm, rlonu, rlatv , interbar )
    307       !
    308       varname = 'rads'
    309       radsol(:) = 0.0
    310       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,
    311      .    jjm, rlonu, rlatv , interbar )
    312       !
    313       varname = 'deltat'
    314       deltat(:) = 0.0
    315       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0,
    316      .     jjm, rlonu, rlatv , interbar )
    317       !
    318       varname = 'rugmer'
    319       rugmer(:) = 0.0
    320       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,
    321      .     jjm, rlonu, rlatv , interbar )
    322       !
    323 !      varname = 'agesno'
    324 !      agesno(:) = 0.0
    325 !      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
    326 !     .     jjm, rlonu, rlatv , interbar )
    327 
    328       varname = 'zmea'
    329       zmea(:) = 0.0
    330       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
    331      .     jjm, rlonu, rlatv , interbar )
    332 
    333       varname = 'zstd'
    334       zstd(:) = 0.0
    335       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
    336      .     jjm, rlonu, rlatv , interbar )
    337       varname = 'zsig'
    338       zsig(:) = 0.0
    339       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
    340      .     jjm, rlonu, rlatv , interbar )
    341       varname = 'zgam'
    342       zgam(:) = 0.0
    343       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
    344      .     jjm, rlonu, rlatv , interbar )
    345       varname = 'zthe'
    346       zthe(:) = 0.0
    347       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
    348      .     jjm, rlonu, rlatv , interbar )
    349       varname = 'zpic'
    350       zpic(:) = 0.0
    351       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
    352      .     jjm, rlonu, rlatv , interbar )
    353       varname = 'zval'
    354       zval(:) = 0.0
    355       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
    356      .     jjm, rlonu, rlatv , interbar )
    357 c
    358       rugsrel(:) = 0.0
    359       IF(ok_orodr)  THEN
    360         DO i = 1, iip1* jjp1
    361          rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
    362         ENDDO
    363       ENDIF
     162
     163
    364164C
    365165C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
    366166C utilise pour calculer les poids et pour assurer l'adequation entre les
    367 C fractions d'ocean vu par l'atmosphere et l'ocean
     167C fractions d'ocean vu par l'atmosphere et l'ocean. Sinon, on cree le masque
     168C a partir du fichier relief
    368169C
    369170
    … …  
    373174        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
    374175        write(*,*)'Run force'
     176        varname = 'masque'
     177        masque(:,:) = 0.0
     178        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0,
     179     ,  jjm ,rlonu,rlatv , interbar )
     180        WRITE(*,*) 'MASQUE construit : Masque'
     181        WRITE(*,'(97I1)') nINT(masque(:,:))
     182        call gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
     183        WHERE (zmasq(1 : klon) .LT. EPSFRA)
     184            zmasq(1 : klon) = 0.
     185        END WHERE
     186        WHERE (1. - zmasq(1 : klon) .LT. EPSFRA)
     187            zmasq(1 : klon) = 1.
     188        END WHERE
    375189      else
    376190        couple = .true.
    … …  
    406220C passage masque ocean a la grille physique
    407221C
    408 
    409222        write(*,*)'ocemask '
    410223        write(*,'(96i1)')int(ocemask)
    … …  
    417230        ocemask_fi(klon) = ocemask(1,jjp1)
    418231        zmasq = 1. - ocemask_fi
    419         isst = 0
    420         where (ocemask_fi(2:klon-1) >0.) isst = 1
    421232      endif
     233
     234      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
     235
     236      varname = 'relief'
     237      ! This line needs to be replaced by a call to restget to get the values in the restart file
     238      orog(:,:) = 0.0
     239       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0 ,
     240     , jjm ,rlonu,rlatv , interbar, masque )
     241      !
     242      WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
     243!      WRITE(*,'(49I1)') INT(orog(:,:))
     244      !
     245      varname = 'rugosite'
     246      ! This line needs to be replaced by a call to restget to get the values in the restart file
     247      rugo(:,:) = 0.0
     248       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0 ,
     249     , jjm, rlonu,rlatv , interbar )
     250      !
     251      WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite'
     252!      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
     253      !
     254C
     255C on initialise les sous surfaces
     256C
     257      pctsrf=0.
     258c
     259      varname = 'psol'
     260      psol(:,:) = 0.0
     261      CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0 ,
     262     , jjm ,rlonu,rlatv , interbar )
     263      !
     264      !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM
     265      !  anyway.
     266      !
     267!      WRITE(*,*) 'PSOL :', psol(10,20)
     268!      WRITE(*,*) ap(:), bp(:)
     269      CALL pression(ip1jmp1, ap, bp, psol, p3d)
     270!      WRITE(*,*) 'P3D :', p3d(10,20,:)
     271      CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, workvar)
     272!      WRITE(*,*) 'PK:', pk(10,20,:)
     273      !
     274      !
     275      !
     276      prefkap =  preff  ** kappa
     277!      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
     278      DO l = 1, llm
     279        DO j=1,jjp1
     280          DO i =1, iip1
     281            pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     282           ENDDO
     283        ENDDO
     284      ENDDO
     285      !
     286!      WRITE(*,*) 'PLS :', pls(10,20,:)
     287      !
     288      varname = 'surfgeo'
     289      phis(:,:) = 0.0
     290      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0 ,
     291     , jjm ,rlonu,rlatv, interbar )
     292      !
     293      varname = 'u'
     294      uvent(:,:,:) = 0.0
     295      CALL startget(varname, iip1, jjp1, rlonu, rlatu, llm, pls,
     296     . workvar, uvent, 0.0, jjm ,rlonv, rlatv, interbar )
     297      ! 
     298      varname = 'v'
     299      vvent(:,:,:) = 0.0
     300      CALL startget(varname, iip1, jjm, rlonv, rlatv, llm, pls,
     301     . workvar, vvent, 0.0, jjp1, rlonu, rlatu, interbar )
     302      !
     303      varname = 't'
     304      t3d(:,:,:) = 0.0
     305      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
     306     . workvar, t3d, 0.0 , jjm, rlonu, rlatv , interbar )
     307      !
     308      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
     309     .                          maxval(t3d(:,:,:))
     310      varname = 'tpot'
     311      tpot(:,:,:) = 0.0
     312      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
     313     . pk, tpot, 0.0 , jjm, rlonu, rlatv , interbar )
     314      !
     315      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
     316     .                          maxval(t3d(:,:,:))
     317      WRITE(*,*) 'PLS min,max:',minval(pls(:,:,:)),
     318     .                          maxval(pls(:,:,:))
     319      DO l = 1, llm
     320        DO j=1,jjp1
     321          DO i =1, iip1-1
     322           qsat(i,j,l) = q_sat(t3d(i,j,l),pls(i,j,l)/100. )
     323          ENDDO
     324          qsat(iip1,j,l) = qsat(1,j,l)
     325        ENDDO
     326      ENDDO
     327      WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
     328     .                           maxval(qsat(:,:,:))
     329      !
     330      WRITE(*,*) 'QSAT :', qsat(10,20,:)
     331      !
     332      varname = 'q'
     333      qd(:,:,:) = 0.0
     334      q3d(:,:,:,:) = 0.0
     335      WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
     336     .                           maxval(qsat(:,:,:))
     337      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
     338     . qsat, qd, 0.0, jjm, rlonu, rlatv , interbar )
     339      q3d(:,:,:,1) = qd(:,:,:)
     340      !
     341      varname = 'tsol'
     342      ! This line needs to be replaced by a call to restget to get the values in the restart file
     343      tsol(:) = 0.0
     344      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0,
     345     .    jjm, rlonu, rlatv , interbar )
     346      !
     347      WRITE(*,*) 'TSOL construit :'
     348!      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
     349      !
     350      varname = 'qsol'
     351      qsol(:) = 0.0
     352      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0,
     353     .   jjm, rlonu, rlatv , interbar )
     354      !
     355      varname = 'snow'
     356      sn(:) = 0.0
     357      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0,
     358     .    jjm, rlonu, rlatv , interbar )
     359      !
     360      varname = 'rads'
     361      radsol(:) = 0.0
     362      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,
     363     .    jjm, rlonu, rlatv , interbar )
     364      !
     365      varname = 'deltat'
     366      deltat(:) = 0.0
     367      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0,
     368     .     jjm, rlonu, rlatv , interbar )
     369      !
     370      varname = 'rugmer'
     371      rugmer(:) = 0.0
     372      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,
     373     .     jjm, rlonu, rlatv , interbar )
     374      !
     375!      varname = 'agesno'
     376!      agesno(:) = 0.0
     377!      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
     378!     .     jjm, rlonu, rlatv , interbar )
     379
     380      varname = 'zmea'
     381      zmea(:) = 0.0
     382      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
     383     .     jjm, rlonu, rlatv , interbar )
     384
     385      varname = 'zstd'
     386      zstd(:) = 0.0
     387      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
     388     .     jjm, rlonu, rlatv , interbar )
     389      varname = 'zsig'
     390      zsig(:) = 0.0
     391      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
     392     .     jjm, rlonu, rlatv , interbar )
     393      varname = 'zgam'
     394      zgam(:) = 0.0
     395      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
     396     .     jjm, rlonu, rlatv , interbar )
     397      varname = 'zthe'
     398      zthe(:) = 0.0
     399      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
     400     .     jjm, rlonu, rlatv , interbar )
     401      varname = 'zpic'
     402      zpic(:) = 0.0
     403      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
     404     .     jjm, rlonu, rlatv , interbar )
     405      varname = 'zval'
     406      zval(:) = 0.0
     407      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
     408     .     jjm, rlonu, rlatv , interbar )
     409c
     410      rugsrel(:) = 0.0
     411      IF(ok_orodr)  THEN
     412        DO i = 1, iip1* jjp1
     413         rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
     414        ENDDO
     415      ENDIF
    422416
    423417
Note: See TracChangeset for help on using the changeset viewer.