Ignore:
Timestamp:
Jan 30, 2002, 8:38:26 PM (23 years ago)
Author:
lmdzadmin
Message:

Inclusion des fractions de surface dans limit_netcdf (create_etat0_limit.F) +
petit menage cosmetique
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/dyn3d
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_etat0_limit.F

    r320 r325  
    2121#include "dimensions.h"
    2222#include "paramet.h"
     23#include "indicesol.h"
     24#include "dimphy.h"
    2325      REAL :: masque(iip1,jjp1)
     26      REAL :: pctsrf(klon, nbsrf)
    2427
    25       CALL etat0_netcdf ( interbar, masque )
     28      CALL etat0_netcdf ( interbar, masque, pctsrf )
    2629c
    2730      WRITE(6,1)
     
    3134      WRITE(6,1)
    3235c
    33       CALL  limit_netcdf ( interbar, extrap , oldice, masque )
     36      CALL  limit_netcdf ( interbar, extrap , oldice, masque, pctsrf )
    3437
    35381     FORMAT(//)
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r320 r325  
    22c $Header$
    33c
    4       SUBROUTINE etat0_netcdf (interbar, masque)
     4      SUBROUTINE etat0_netcdf (interbar, masque, pctsrf)
    55   
    66      USE startvar
     
    165165      !
    166166      WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
    167       WRITE(*,'(49I1)') INT(orog(:,:))
     167!      WRITE(*,'(49I1)') INT(orog(:,:))
    168168      !
    169169      varname = 'rugosite'
     
    174174      !
    175175      WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite'
    176       WRITE(*,'(49I1)') INT(rugo(:,:)*10)
     176!      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
    177177      !
    178178      varname = 'masque'
     
    183183      !
    184184      WRITE(*,*) 'MASQUE construit : Masque'
    185       WRITE(*,'(49I1)') INT(masque(:,:))
     185!      WRITE(*,'(49I1)') INT(masque(:,:))
    186186      !
    187187      !
     
    203203          zmasq(1 : klon) = 1.
    204204      END WHERE
    205       WRITE(*,*)zmasq
    206205
    207206
     
    216215      !  anyway.
    217216      !
    218       WRITE(*,*) 'PSOL :', psol(10,20)
    219       WRITE(*,*) ap(:), bp(:)
     217!      WRITE(*,*) 'PSOL :', psol(10,20)
     218!      WRITE(*,*) ap(:), bp(:)
    220219      CALL pression(ip1jmp1, ap, bp, psol, p3d)
    221       WRITE(*,*) 'P3D :', p3d(10,20,:)
     220!      WRITE(*,*) 'P3D :', p3d(10,20,:)
    222221      CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, workvar)
    223       WRITE(*,*) 'PK:', pk(10,20,:)
     222!      WRITE(*,*) 'PK:', pk(10,20,:)
    224223      !
    225224      !
    226225      !
    227226      prefkap =  preff  ** kappa
    228       WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
     227!      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
    229228      DO l = 1, llm
    230229        DO j=1,jjp1
     
    235234      ENDDO
    236235      !
    237       WRITE(*,*) 'PLS :', pls(10,20,:)
     236!      WRITE(*,*) 'PLS :', pls(10,20,:)
    238237      !
    239238      varname = 'surfgeo'
     
    297296      !
    298297      WRITE(*,*) 'TSOL construit :'
    299       WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
     298!      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
    300299      !
    301300      varname = 'qsol'
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/grid_noro.F

    r228 r325  
    450450      ENDDO
    451451     
    452       WRITE(*,*) 'MVA9 ', IMAR, JMAR
    453       WRITE(*,*) 'MVA9 ', WEIGHTpb
    454       WRITE(*,*) 'MVA9 SUM ', SUM
     452c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
     453c     WRITE(*,*) 'MVA9 ', WEIGHTpb
     454c     WRITE(*,*) 'MVA9 SUM ', SUM
    455455      DO IS=-1,1
    456456        DO JS=-1,1
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/inter_barxy.F

    r317 r325  
    1818c
    1919
    20          print *,' NEEEEE BY ** '
    2120       DO j = 1, jnterfd + 1
    2221        CALL inter_barx( interfd, dlonid, champ( 1,j ),
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/limit_netcdf.F

    r320 r325  
    22C $Header$
    33C
    4       SUBROUTINE limit_netcdf ( interbar, extrap, oldice, masque )
     4      SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf)
    55c
    66      IMPLICIT none
     
    2929#include "comconst.h"
    3030#include "dimphy.h"
     31#include "indicesol.h"
    3132c
    3233c-----------------------------------------------------------------------
    3334      LOGICAL interbar, extrap, oldice
    3435
    35       INTEGER KIDIA, KFDIA, KLON, KLEV
    36 c-----------------------------------------------------------------------
    3736      REAL phy_nat(klon,360), phy_nat0(klon)
    3837      REAL phy_alb(klon,360)
     
    4241      REAL phy_ice(klon,360)
    4342c
     43      real pctsrf_t(klon,nbsrf,360)
     44      real pctsrf(klon,nbsrf)
     45      REAL verif
     46
    4447      REAL masque(iip1,jjp1)
    4548      REAL mask(iim,jjp1)
     49CPB
     50C newlmt indique l'utilisation de la sous-maille fractionnelle
     51C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
     52      LOGICAL newlmt, fracterre
     53      PARAMETER(newlmt=.TRUE.)
     54      PARAMETER(fracterre = .TRUE.)
    4655
    4756C Declarations pour le champ de depart
     
    8392      INTEGER id_tim
    8493      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
    85 
    86       INTEGER i, j, k, l
     94CPB
     95      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
     96
     97      INTEGER i, j, k, l, ji
     98c declarations pour lecture glace de mer
     99      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
     100      INTEGER :: itaul(1), fid
     101      REAL :: lev(1), date, dt
     102      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
     103      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
     104      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
     105      REAL :: flic_tmp(iip1, jjp1)
     106
    87107c Diverses variables locales
    88108      REAL time
     109! pour la lecture du fichier masque ocean
     110      integer :: nid_o2a
     111      logical :: couple = .false.
     112      INTEGER :: iml_omask, jml_omask
     113      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
     114      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
     115      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
     116      real, dimension(klon) :: ocemask_fi
    89117
    90118      INTEGER          longcles
     
    94122      INTEGER ncid,varid,ndimid(4),dimid
    95123      character*30 namedim
     124      CHARACTER*80 :: varname
     125
     126c initialisations:
     127      CALL conf_gcm( 99, .TRUE. , clesphy0 )
     128
    96129
    97130      pi     = 4. * ATAN(1.)
     
    103136      cpp    = 1004.70885
    104137      dtvr    = daysec/FLOAT(day_step)
     138      CALL inigeom
    105139c
    106140C Traitement du relief au sol
     
    589623         CALL gr_dyn_fi(1, iip1, jjp1, klon,
    590624     .                  champan(1,1,k), phy_ice(1,k))
    591          DO i = 1, klon
    592             phy_nat(i,k) = zmasq(i)
    593             IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
    594                IF (NINT(zmasq(i)).EQ.0) THEN
    595                   phy_nat(i,k) = 3.0
    596                ELSE
    597                   phy_nat(i,k) = 2.0
    598                ENDIF
     625        IF ( newlmt) THEN
     626
     627CPB  en attendant de mettre fraction de terre
     628c
     629          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
     630          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
     631c
     632          IF (fracterre ) THEN
     633c            WRITE(*,*) 'passe dans cas fracterre'
     634            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
     635            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
     636            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon)
     637     $            - pctsrf_t(1:klon,is_lic,k)
     638c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
     639            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
     640              pctsrf_t(1:klon,is_sic,k) = 0.
     641            END WHERE
     642            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
     643              pctsrf_t(1:klon,is_sic,k) = 0.
     644              pctsrf_t(1:klon,is_oce,k) = 0.
     645            END WHERE
     646            DO i = 1, klon
     647              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
     648                IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
     649                  pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
     650                  pctsrf_t(i,is_oce,k) = 0.
     651                ELSE
     652                  pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
     653     $                    - pctsrf_t(i,is_sic,k)
     654                  IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
     655                    pctsrf_t(i,is_oce,k) = 0.
     656                    pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
     657                  ENDIF
     658                ENDIF
     659              ENDIF 
     660              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
     661                WRITE(*,*) 'pb sous maille au point : i,k '
     662     $              , i,k,pctsrf_t(:,is_oce,k)
     663              ENDIF
     664              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
     665     $          pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.)
     666     $            .GT. EPSFRA) THEN
     667                  WRITE(*,*) 'physiq : pb sous surface au point ', i,
     668     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
     669              ENDIF
     670            END DO
     671          ELSE
     672            DO i = 1, klon
     673              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
     674              IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
     675                pctsrf_t(i,is_sic,k) = 0.
     676                pctsrf_t(i,is_oce,k) = 0.                 
     677                IF(phy_ice(i) .GE. 1.e-5) THEN
     678                  pctsrf_t(i,is_lic,k) = phy_ice(i)
     679                  pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k)
     680     .                                   - pctsrf_t(i,is_lic,k)
     681                ELSE
     682                  pctsrf_t(i,is_lic,k) = 0.
     683                ENDIF
     684              ELSE
     685                pctsrf_t(i,is_lic,k) = 0.
     686                IF(phy_ice(i) .GE. 1.e-5) THEN
     687                  pctsrf_t(i,is_ter,k) = 0.
     688                  pctsrf_t(i,is_sic,k) = phy_ice(i)
     689                  pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
     690                ELSE
     691                  pctsrf_t(i,is_sic,k) = 0.
     692                  pctsrf_t(i,is_oce,k) = 1.                     
     693                ENDIF
     694              ENDIF
     695              verif = pctsrf_t(i,is_ter,k) +
     696     .                pctsrf_t(i,is_oce,k) +
     697     .                pctsrf_t(i,is_sic,k) +
     698     .                pctsrf_t(i,is_lic,k)
     699              IF ( verif .LT. 1. - 1.e-5 .OR.
     700     $             verif .GT. 1 + 1.e-5) THEN 
     701                WRITE(*,*) 'pb sous maille au point : i,k,verif '
     702     $                    , i,k,verif
     703              ENDIF
     704            END DO
     705          ENDIF
     706        ELSE 
     707          DO i = 1, klon
     708            phy_nat(i,k) = phy_nat0(i)
     709            IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
     710              IF (NINT(phy_nat0(i)).EQ.0) THEN
     711                phy_nat(i,k) = 3.0
     712              ELSE
     713                phy_nat(i,k) = 2.0
     714              ENDIF
    599715            ENDIF
    600716            IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
    601717              IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
    602718            ENDIF
    603          ENDDO
    604 
     719          END DO
     720        ENDIF
    605721      ENDDO
    606722c
     
    10041120      dims(2) = ntim
    10051121c
    1006 ccc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
    10071122      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
    10081123      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
    10091124     .                        "Jour dans l annee")
    1010 ccc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
    1011       ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
    1012       ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
    1013      .                        "Nature du sol (0,1,2,3)")
    1014 ccc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
     1125      IF (newlmt) THEN
     1126c
     1127        ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
     1128        ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
     1129     .                      "Fraction ocean")
     1130c
     1131        ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
     1132        ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
     1133     .                      "Fraction glace de mer")
     1134c
     1135        ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
     1136        ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
     1137     .                      "Fraction terre")
     1138c
     1139        ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
     1140        ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
     1141     .                      "Fraction land ice")
     1142c
     1143      ELSE
     1144        ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
     1145        ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
     1146     .                      "Nature du sol (0,1,2,3)")
     1147      ENDIF
    10151148      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
    10161149      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
    1017      .                        "Temperature superficielle de la mer")
    1018 ccc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
     1150     .                      "Temperature superficielle de la mer")
    10191151      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
    10201152      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
    10211153     .                        "Reference flux de chaleur au sol")
    1022 ccc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
    10231154      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
    10241155      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
    10251156     .                        "Albedo a la surface")
    1026 ccc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
    10271157      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
    10281158      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
     
    10401170#ifdef NC_DOUBLE
    10411171      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
    1042       ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
     1172c
     1173      IF (newlmt ) THEN
     1174          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
     1175     $        ,pctsrf_t(1,is_oce,k))
     1176          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
     1177     $        ,pctsrf_t(1,is_sic,k))
     1178          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
     1179     $        ,pctsrf_t(1,is_ter,k))
     1180          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
     1181     $        ,pctsrf_t(1,is_lic,k))
     1182      ELSE
     1183          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
     1184     $        ,phy_nat(1,k))
     1185      ENDIF
     1186c
    10431187      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
    10441188      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
     
    10471191#else
    10481192      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
    1049       ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
     1193      IF (newlmt ) THEN
     1194          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
     1195     $        ,pctsrf_t(1,is_oce,k))
     1196          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
     1197     $        ,pctsrf_t(1,is_sic,k))
     1198          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
     1199     $        ,pctsrf_t(1,is_ter,k))
     1200          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
     1201     $        ,pctsrf_t(1,is_lic,k))
     1202      ELSE
     1203          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
     1204     $        ,phy_nat(1,k))
     1205      ENDIF
    10501206      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
    10511207      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
Note: See TracChangeset for help on using the changeset viewer.