Ignore:
Timestamp:
Sep 9, 2008, 3:22:23 PM (16 years ago)
Author:
lsce
Message:
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

JG

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/surf_land_bucket_mod.F90

    r888 r996  
    88! This module is used when no external land model is choosen.
    99!
    10   USE fonte_neige_mod
    11   USE calcul_fluxs_mod
    12   USE dimphy
    13   USE mod_grid_phy_lmdz
    14   USE mod_phys_lmdz_para
    15  
    1610  IMPLICIT NONE
    1711
    … …  
    2620       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
    2721
     22    USE limit_read_mod
     23    USE surface_data
     24    USE fonte_neige_mod
     25    USE calcul_fluxs_mod
     26    USE cpl_mod
     27    USE dimphy
     28    USE mod_grid_phy_lmdz
     29    USE mod_phys_lmdz_para
    2830!****************************************************************************************
    2931! Bucket calculations for surface.
    … …  
    7476    REAL, DIMENSION(klon) :: zfra
    7577    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
     78    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
    7679    INTEGER               :: i
    7780!
    … …  
    8285!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
    8386!
    84     CALL interfsur_lim(itime, dtime, jour, &
    85          knon, knindex, debut,  &
    86          alb_lim, z0_new)
    87    
     87    CALL limit_read_rug_alb(itime, dtime, jour,&
     88         knon, knindex, &
     89         z0_new, alb_lim)
    8890!
    8991!* Calcultaion of fluxes
    … …  
    145147!* Calculate the rugosity
    146148!
    147     z0_new = SQRT(z0_new**2+rugoro**2)
    148        
     149    DO i = 1, knon
     150       z0_new(i) = SQRT(z0_new(i)**2+rugoro(i)**2)
     151    END DO
     152
     153!* Send to coupler
     154!  The run-off from river and coast are not calculated in the bucket modele.
     155!  For testing purpose of the coupled modele we put the run-off to zero.
     156    IF (type_ocean=='couple') THEN
     157       dummy_riverflow(:)   = 0.0
     158       dummy_coastalflow(:) = 0.0
     159       CALL cpl_send_land_fields(itime, knon, knindex, &
     160            dummy_riverflow, dummy_coastalflow)
     161    ENDIF
     162
    149163!
    150164!* End
    … …  
    154168!****************************************************************************************
    155169!
    156   SUBROUTINE interfsur_lim(itime, dtime, jour, &
    157        knon, knindex, debut, &
    158        lmt_alb_p, lmt_rug_p)
    159    
    160 ! Cette routine sert d'interface entre le modele atmospherique et un fichier
    161 ! de conditions aux limites
    162 !
    163 ! L. Fairhead 02/2000
    164 !
    165 ! input:
    166 !   itime        numero du pas de temps courant
    167 !   dtime        pas de temps de la physique (en s)
    168 !   jour         jour a lire dans l'annee
    169 !   knon         nombre de points dans le domaine a traiter
    170 !   knindex      index des points de la surface a traiter
    171 !   debut        logical: 1er appel a la physique (initialisation)
    172 !
    173 ! output:
    174 !   lmt_alb_p      Albedo lu
    175 !   lmt_rug_p      longueur de rugosite lue
    176 
    177     INCLUDE "netcdf.inc"
    178 
    179 ! Input variables
    180 !****************************************************************************************
    181     INTEGER, INTENT(IN)                      :: itime
    182     REAL   , INTENT(IN)                      :: dtime
    183     INTEGER, INTENT(IN)                      :: jour
    184     INTEGER, INTENT(IN)                      :: knon
    185     INTEGER, DIMENSION(klon_loc), INTENT(IN) :: knindex
    186     LOGICAL, INTENT(IN)                      :: debut
    187 
    188 ! Output variables
    189 !****************************************************************************************
    190     REAL, INTENT(out), DIMENSION(klon_loc)   :: lmt_alb_p
    191     REAL, INTENT(out), DIMENSION(klon_loc)   :: lmt_rug_p
    192 
    193 ! Local variables with attribute SAVE
    194 !****************************************************************************************
    195     INTEGER,SAVE   :: lmt_pas     ! frequence de lecture des conditions limites
    196                                   ! (en pas de physique)
    197     !$OMP THREADPRIVATE(lmt_pas)
    198     LOGICAL,SAVE   :: deja_lu_sur ! pour indiquer que le jour a lire a deja
    199                                   ! lu pour une surface precedente
    200     !$OMP THREADPRIVATE(deja_lu_sur)
    201     INTEGER,SAVE                           :: jour_lu_sur
    202     !$OMP THREADPRIVATE(jour_lu_sur)
    203     CHARACTER (len = 20),SAVE              :: fich ='limit.nc'
    204     !$OMP THREADPRIVATE(fich)
    205     LOGICAL,SAVE                           :: check = .FALSE.
    206     !$OMP THREADPRIVATE(check)
    207 ! Champs lus dans le fichier de CL
    208     REAL, ALLOCATABLE , SAVE, DIMENSION(:) :: alb_lu_p, rug_lu_p
    209     !$OMP THREADPRIVATE(alb_lu_p, rug_lu_p)
    210 
    211 ! quelques variables pour netcdf
    212     INTEGER ,SAVE                          :: nid, nvarid
    213     !$OMP THREADPRIVATE(nid, nvarid)
    214     INTEGER, DIMENSION(2),SAVE             :: start, epais
    215     !$OMP THREADPRIVATE(start, epais)
    216 
    217 ! Other local variables
    218 !****************************************************************************************
    219     INTEGER                                :: ii, ierr
    220     CHARACTER (len = 20)                   :: modname = 'interfsur_lim'
    221     CHARACTER (len = 80)                   :: abort_message
    222     REAL, DIMENSION(klon_glo)              :: alb_lu
    223     REAL, DIMENSION(klon_glo)              :: rug_lu
    224 
    225 !
    226 ! End delaration
    227 !****************************************************************************************
    228 
    229     IF (debut) THEN
    230        lmt_pas = NINT(86400./dtime * 1.0) ! pour une lecture une fois par jour
    231        jour_lu_sur = jour - 1
    232        ALLOCATE(alb_lu_p(klon_loc))
    233        ALLOCATE(rug_lu_p(klon_loc))
    234     ENDIF
    235    
    236     IF ((jour - jour_lu_sur) /= 0) deja_lu_sur = .FALSE.
    237  
    238     IF (check) WRITE(*,*) modname,':: jour_lu_sur, deja_lu_sur', jour_lu_sur, deja_lu_sur
    239     IF (check) WRITE(*,*) modname,':: itime, lmt_pas', itime, lmt_pas
    240     IF (check) CALL flush(6)
    241 
    242 !   
    243 ! Tester d'abord si c'est le moment de lire le fichier
    244 !
    245     IF (MOD(itime-1, lmt_pas) == 0 .AND. .NOT. deja_lu_sur) THEN
    246 
    247 !
    248 ! Ouverture et lecture du fichier
    249 !
    250 !$OMP MASTER
    251        IF (is_mpi_root) THEN
    252           fich = TRIM(fich)
    253           IF (check) WRITE(*,*)modname,' ouverture fichier ',fich
    254           IF (check) CALL flush(6)
    255           ierr = NF_OPEN (fich, NF_NOWRITE,nid)
    256           IF (ierr.NE.NF_NOERR) THEN
    257              abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
    258              CALL abort_gcm(modname,abort_message,1)
    259           ENDIF
    260 !
    261 ! La tranche de donnees a lire:
    262           start(1) = 1
    263           start(2) = jour
    264           epais(1) = klon_glo
    265           epais(2) = 1
    266 !
    267 ! Lecture albedo
    268           ierr = NF_INQ_VARID(nid, 'ALB', nvarid)
    269           IF (ierr /= NF_NOERR) THEN
    270              abort_message = 'Le champ <ALB> est absent'
    271              CALL abort_gcm(modname,abort_message,1)
    272           ENDIF
    273 #ifdef NC_DOUBLE
    274           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, alb_lu)
    275 #else
    276           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, alb_lu)
    277 #endif
    278           IF (ierr /= NF_NOERR) THEN
    279              abort_message = 'Lecture echouee pour <ALB>'
    280              CALL abort_gcm(modname,abort_message,1)
    281           ENDIF
    282 !
    283 ! Lecture rugosite!
    284           ierr = NF_INQ_VARID(nid, 'RUG', nvarid)
    285           IF (ierr /= NF_NOERR) THEN
    286              abort_message = 'Le champ <RUG> est absent'
    287              CALL abort_gcm(modname,abort_message,1)
    288           ENDIF
    289 #ifdef NC_DOUBLE
    290           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, rug_lu)
    291 #else
    292           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, rug_lu)
    293 #endif
    294           IF (ierr /= NF_NOERR) THEN
    295              abort_message = 'Lecture echouee pour <RUG>'
    296              CALL abort_gcm(modname,abort_message,1)
    297           ENDIF
    298 
    299 !
    300 ! Fin de lecture
    301           ierr = NF_CLOSE(nid)
    302 
    303        ENDIF ! is_mpi_root
    304 !$OMP END MASTER
    305 
    306        CALL Scatter(alb_lu,alb_lu_p)
    307        CALL Scatter(rug_lu,rug_lu_p)
    308 
    309        deja_lu_sur = .TRUE.
    310        jour_lu_sur = jour       
    311 
    312     ENDIF
    313  
    314 !
    315 ! Recopie des variables dans les champs de sortie
    316 !
    317     lmt_alb_p(:) = 999999.
    318     lmt_rug_p(:) = 999999.
    319     DO ii = 1, knon
    320        lmt_alb_p(ii) = alb_lu_p(knindex(ii))
    321        lmt_rug_p(ii) = rug_lu_p(knindex(ii))
    322     ENDDO
    323    
    324 
    325   END SUBROUTINE interfsur_lim
    326 !
    327 !****************************************************************************************
    328 !
    329170END MODULE surf_land_bucket_mod
Note: See TracChangeset for help on using the changeset viewer.