Changeset 2665


Ignore:
Timestamp:
Oct 12, 2016, 2:53:20 PM (8 years ago)
Author:
dcugnet
Message:
  • A (re)startphy.nc file (standard name: "startphy0.nc") can be read by ce0l to get land mask, so mask can be defined (in decreasing priority order) from: 1) "o2a.nc file" if this file is found 2) "startphy0.nc" if this file is found 3) "Relief.nc" otherwise
  • Sub-cell scales parameters for orographic gravity waves can be read from file "oro_params.nc" if the configuration key "read_orop" is TRUE. The effect is to bypass the "grid_noro" routine in ce0l, so that any pre-defined mask (from o2a.nc or startphy0.nc) is then overwritten.
  • The gcm stops if the "limit.nc" records number differs from the current year number of days. A warning is issued in case the gcm calendar does not match the time axis attribute "calendar" (if available) from the "limit.nc" file. This attribute is now added to the "limit.nc" time axis.
  • Few simplifications in grid_noro
  • Few parameters changes in acama_gwd and flott_gwd.
  • Variable d_u can be saved in the outputs.
Location:
LMDZ5/trunk/libf
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3d/conf_gcm.F90

    r2603 r2665  
    1818  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    1919                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    20                        ysinus
     20                       ysinus, read_orop
    2121  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2222                       alphax,alphay,taux,tauy
    … …  
    854854     CALL getin('ok_etat0',ok_etat0)
    855855
     856     !Config  Key  = read_orop
     857     !Config  Desc = lecture du fichier de params orographiques sous maille
     858     !Config  Def  = f
     859     !Config  Help = lecture fichier plutot que grid_noro
     860
     861     read_orop = .FALSE.
     862     CALL getin('read_orop',read_orop)
     863
    856864     write(lunout,*)' #########################################'
    857865     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    900908     write(lunout,*)' ok_limit = ', ok_limit
    901909     write(lunout,*)' ok_etat0 = ', ok_etat0
     910     write(lunout,*)' read_orop = ', read_orop
    902911  end IF test_etatinit
    903912

  • LMDZ5/trunk/libf/dyn3d/logic_mod.F90

    r2603 r2665  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F90

    r2603 r2665  
    2222  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    2323                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    24                        ysinus
     24                       ysinus, read_orop
    2525  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2626                       alphax,alphay,taux,tauy
    … …  
    929929     CALL getin('ok_etat0',ok_etat0)
    930930
     931     !Config  Key  = read_orop
     932     !Config  Desc = lecture du fichier de params orographiques sous maille
     933     !Config  Def  = f
     934     !Config  Help = lecture fichier plutot que grid_noro
     935
     936     read_orop = .FALSE.
     937     CALL getin('read_orop',read_orop)
     938
    931939     write(lunout,*)' #########################################'
    932940     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    977985     write(lunout,*)' ok_limit = ', ok_limit
    978986     write(lunout,*)' ok_etat0 = ', ok_etat0
     987     write(lunout,*)' read_orop = ', read_orop
    979988  end IF test_etatinit
    980989

  • LMDZ5/trunk/libf/dyn3dmem/logic_mod.F90

    r2603 r2665  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/trunk/libf/dyn3dpar/conf_gcm.F90

    r2603 r2665  
    2121  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    2222                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    23                        ysinus
     23                       ysinus, read_orop
    2424  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2525                       alphax,alphay,taux,tauy
    … …  
    925925     CALL getin('ok_etat0',ok_etat0)
    926926
     927     !Config  Key  = read_orop
     928     !Config  Desc = lecture du fichier de params orographiques sous maille
     929     !Config  Def  = f
     930     !Config  Help = lecture fichier plutot que grid_noro
     931
     932     read_orop = .FALSE.
     933     CALL getin('read_orop',read_orop)
     934
    927935     write(lunout,*)' #########################################'
    928936     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    973981     write(lunout,*)' ok_limit = ', ok_limit
    974982     write(lunout,*)' ok_etat0 = ', ok_etat0
     983     write(lunout,*)' read_orop = ', read_orop
    975984  end IF test_etatinit
    976985

  • LMDZ5/trunk/libf/dyn3dpar/logic_mod.F90

    r2603 r2665  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90

    r2603 r2665  
    1212!     * "masque" can be:
    1313!       - read from file "o2a.nc"          (for coupled runs).
     14!       - read from file "startphy0.nc"    (from a previous run).
    1415!       - created in etat0phys or etat0dyn (for forced  runs).
    1516!     It is then passed to limit_netcdf to ensure consistancy.
    … …  
    2021  USE etat0phys,      ONLY: etat0phys_netcdf
    2122  USE limit,          ONLY: limit_netcdf
    22   USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
     23  USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR,    &
     24         NF90_INQUIRE_DIMENSION, NF90_INQ_DIMID, NF90_INQ_VARID, NF90_GET_VAR
    2325  USE infotrac,       ONLY: type_trac, infotrac_init
    2426  USE dimphy,         ONLY: klon
    … …  
    6062  REAL, ALLOCATABLE  :: lat_omask(:,:), dlat_omask(:), ocetmp (:,:)
    6163  REAL               :: date, lev(1)
     64
     65!--- Local variables for land mask from startphy0 file reading
     66  INTEGER            :: nid_sta, nid_nph, nid_msk, nphys
     67  REAL, ALLOCATABLE  :: masktmp(:)
     68
    6269#ifndef CPP_PARA
    6370! for iniphysiq in serial mode
    … …  
    133140  ENDIF
    134141
    135 !--- LAND MASK. TWO CASES:
     142!--- LAND MASK. THREE CASES:
    136143!   1) read from ocean model    file "o2a.nc"    (coupled runs)
    137 !   2) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
    138 ! Coupled simulations (case 1) use the ocean model mask to compute the
     144!   2) read from previous run   file="startphy0.nc"
     145!   3) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
     146! In the first case, the mask from the ocean model is used compute the
    139147! weights to ensure ocean fractions are the same for atmosphere and ocean.
    140148!*******************************************************************************
    141   IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)/=NF90_NOERR) THEN
    142     WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file found'
    143     WRITE(lunout,*)'Forced run.'
    144     masque(:,:)=-99999.
    145   ELSE
     149  IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)==NF90_NOERR) THEN
    146150    iret=NF90_CLOSE(nid_o2a)
    147151    WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found'
    … …  
    175179    masque(iip1 ,:)=masque(1,:)
    176180    DEALLOCATE(ocemask)
     181  ELSE IF(NF90_OPEN("startphy0.nc", NF90_NOWRITE, nid_sta)==NF90_NOERR) THEN
     182    WRITE(lunout,*)'BEWARE !! File "startphy0.nc" found.'
     183    WRITE(lunout,*)'Getting the land mask from a previous run.'
     184    iret=NF90_INQ_DIMID(nid_sta,'points_physiques',nid_nph)
     185    iret=NF90_INQUIRE_DIMENSION(nid_sta,nid_nph,len=nphys)
     186    IF(nphys/=klon) THEN
     187      WRITE(lunout,*)'Mismatching dimensions for land mask'
     188      WRITE(lunout,*)'nphys  = ',nphys ,' klon = ',klon
     189      iret=NF90_CLOSE(nid_sta)
     190      CALL abort_gcm(modname,'',1)
     191    END IF
     192    ALLOCATE(masktmp(klon))
     193    iret=NF90_INQ_VARID(nid_sta,'masque',nid_msk)
     194    iret=NF90_GET_VAR(nid_sta,nid_msk,masktmp)
     195    iret=NF90_CLOSE(nid_sta)
     196    CALL gr_fi_dyn(1,klon,iip1,jjp1,masktmp,masque)
     197    IF(prt_level>=1) THEN
     198      WRITE(fmt,"(i4,'i1)')")iip1 ; fmt='('//ADJUSTL(fmt)
     199      WRITE(lunout,*)'LAND MASK :'
     200      WRITE(lunout,fmt) NINT(masque)
     201    END IF
     202    DEALLOCATE(masktmp)
     203  ELSE
     204    WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file or "startphy0.nc" file found'
     205    WRITE(lunout,*)'Land mask will be built from the topography file.'
     206    masque(:,:)=-99999.
    177207  END IF
    178208  phis(:,:)=-99999.

  • LMDZ5/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

    r2644 r2665  
    5959  INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
    6060  REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
     61  CHARACTER(LEN=256), PARAMETER :: oroparam="oro_params.nc"
    6162  CHARACTER(LEN=256), PARAMETER :: orofname="Relief.nc", orogvar="RELIEF"
    6263  CHARACTER(LEN=256), PARAMETER :: phyfname="ECPHY.nc",  psrfvar="SP"
    … …  
    255256!   This routine launch grid_noro, which computes parameters for SSO scheme as
    256257!   described in LOTT & MILLER (1997) and LOTT(1999).
     258!   In case the file oroparam is present and the key read_orop is activated,
     259!   grid_noro is bypassed and sub-cell parameters are read from the file.
    257260!===============================================================================
    258   USE grid_noro_m, ONLY: grid_noro
     261  USE grid_noro_m, ONLY: grid_noro, read_noro
     262  USE logic_mod,   ONLY: read_orop
    259263  IMPLICIT NONE
    260264!-------------------------------------------------------------------------------
    … …  
    266270  CHARACTER(LEN=256) :: modname
    267271  INTEGER            :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1)
     272  INTEGER            :: ierr
    268273  REAL               :: lev(1), date, dt
    269274  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:)
    … …  
    306311  ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights
    307312
     313!--- READ SUB-CELL SCALES PARAMETERS FROM A FILE (AT RIGHT RESOLUTION)
     314  OPEN(UNIT=66,FILE=oroparam,STATUS='OLD',IOSTAT=ierr)
     315  IF(ierr==0.AND.read_orop) THEN
     316    CLOSE(UNIT=66)
     317    CALL read_noro(lon_in,lat_in,oroparam,                                     &
     318                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
     319  ELSE
    308320!--- CALL OROGRAPHY MODULE TO COMPUTE FIELDS
    309   CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,phis,zmea0,zstd0,     &
    310                                       zsig0,zgam0,zthe0,zpic0,zval0,masque)
     321    CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,                    &
     322                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
     323  END IF
    311324  phis = phis * 9.81
    312325  phis(iml,:) = phis(1,:)

  • LMDZ5/trunk/libf/dynphy_lonlat/phylmd/limit_netcdf.F90

    r2603 r2665  
    7171  USE netcdf95,           ONLY: nf95_def_var, nf95_put_att, nf95_put_var
    7272  USE comconst_mod, ONLY: pi
     73  USE phys_cal_mod, ONLY: calend
    7374  IMPLICIT NONE
    7475!-------------------------------------------------------------------------------
    … …  
    244245  !--- Attributes creation
    245246  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee"),fnam)
     247  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "calendar",calend),fnam)
    246248  CALL ncerr(NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean"),fnam)
    247249  CALL ncerr(NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer"),fnam)
    … …  
    405407      CASE('SIC', 'SST'); cal_in='gregorian'
    406408    END SELECT
    407   CALL msg(5,'WARNING: missing "calendar" attribute for "time" in '&
     409    CALL msg(5,'WARNING: missing "calendar" attribute for "time" in '&
    408410     &//TRIM(fnam)//'. Choosing default value.')
    409411  END IF
     412  CALL strclean(cal_in)                     !--- REMOVE (WEIRD) NULL CHARACTERS
    410413  CALL msg(5,'var, calendar, dim: '//TRIM(dnam)//' '//TRIM(cal_in), lmdep)
    411414 
    … …  
    477480  fnam_p=fnam(1:idx)//'_p.nc'
    478481  IF(NF90_OPEN(fnam_p,NF90_NOWRITE,ncid)==NF90_NOERR) THEN
    479     CALL msg(0,'Reading previous year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title))
     482    CALL msg(0,'Reading next year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title))
    480483    CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_p)
    481484    CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,1],[imdep,jmdep,1]),fnam_p)
    … …  
    767770!-------------------------------------------------------------------------------
    768771
     772
     773!-------------------------------------------------------------------------------
     774!
     775SUBROUTINE strclean(s)
     776!
     777!-------------------------------------------------------------------------------
     778  IMPLICIT NONE
     779!-------------------------------------------------------------------------------
     780! Purpose: Remove tail null characters from the input string.
     781!-------------------------------------------------------------------------------
     782! Parameters:
     783  CHARACTER(LEN=*), INTENT(INOUT) :: s
     784!-------------------------------------------------------------------------------
     785! Local variable:
     786  INTEGER :: k
     787!-------------------------------------------------------------------------------
     788  k=LEN_TRIM(s); DO WHILE(ICHAR(s(k:k))==0); s(k:k)=' '; k=LEN_TRIM(s); END DO
     789
     790END SUBROUTINE strclean
     791!
     792!-------------------------------------------------------------------------------
     793
    769794#endif
    770795! of #ifndef CPP_1D

  • LMDZ5/trunk/libf/phylmd/acama_gwd_rando_m.F90

    r2357 r2665  
    136136    RUWFRT=gwd_front_ruwmax 
    137137    SATFRT=gwd_front_sat
    138     CMAX = 40.    ! Characteristic phase speed
     138    CMAX = 50.    ! Characteristic phase speed
    139139! Phase speed test
    140140!   RUWFRT=0.01
    … …  
    145145! CRUCIAL PARAMETERS FOR THE WIND FILTERING
    146146    XLAUNCH=0.95 ! Parameter that control launching altitude
    147     RDISS = 1    ! Diffusion parameter
     147    RDISS = 0.5  ! Diffusion parameter
    148148
    149149    ! maximum of rain for which our theory applies (in kg/m^2/s)
    … …  
    377377       !  RESTORE DIMENSION OF A FLUX
    378378       !     *RD*TR/PR
    379              *1. + RUW0(JW, :)
     379       !     *1. + RUW0(JW, :)
     380             *1.
    380381
    381382       ! Factor related to the characteristics of the waves: NONE
    … …  
    417418          ! No breaking (Eq.6)
    418419          ! Dissipation (Eq. 8)
    419           WWP(JW, :) = WWM(JW, :) * EXP(- 2. * RDISS * PR / (PH(:, LL + 1) &
     420          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
    420421               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
    421422               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &

  • LMDZ5/trunk/libf/phylmd/flott_gwd_rando_m.F90

    r2333 r2665  
    120120
    121121   
    122     RDISS = 1. ! Diffusion parameter
     122    RDISS = 0.5 ! Diffusion parameter
    123123    ! ONLINE
    124124      RUWMAX=GWD_RANDO_RUWMAX
    … …  
    346346          ! No breaking (Eq.6)
    347347          ! Dissipation (Eq. 8)
    348           WWP(JW, :) = WWM(JW, :) * EXP(- 2. * RDISS * PR / (PH(:, LL + 1) &
     348          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
    349349               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
    350350               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &

  • LMDZ5/trunk/libf/phylmd/grid_noro_m.F90

    r2576 r2665  
    66  USE assert_eq_m,       ONLY: assert_eq
    77  PRIVATE
    8   PUBLIC :: grid_noro, grid_noro0
     8  PUBLIC :: grid_noro, grid_noro0, read_noro
    99
    1010
    … …  
    7171! CORRELATIONS OF USN OROGRAPHY GRADIENTS         ! dim (imar+2*iext,jmdp+2)
    7272  REAL, ALLOCATABLE :: zxtzxusn(:,:), zytzyusn(:,:), zxtzyusn(:,:)
    73   REAL, ALLOCATABLE :: mask_tmp(:,:), zmea0(:,:)  ! dim (imar+1,jmar)
    74   REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imax,jmax)
    75   REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imax)
    76   REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmax)
     73  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
     74  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
     75  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
    7776  LOGICAL :: masque_lu
    7877  INTEGER :: i, ii, imdp, imar, iext
    7978  INTEGER :: j, jj, jmdp, jmar, nn
    80   REAL    :: xpi, zdeltax, zlenx, weighx, xincr,  zmeanor0
    81   REAL    :: rad, zdeltay, zleny, weighy, masque, zmeasud0
    82   REAL    :: zbordnor, zmeanor, zstdnor, zsignor, zweinor, zpicnor, zvalnor
    83   REAL    :: zbordsud, zmeasud, zstdsud, zsigsud, zweisud, zpicsud, zvalsud
    84   REAL    :: zbordest, zbordoue, xk, xl, xm, xp, xq, xw
     79  REAL    :: xpi, zdeltax, zlenx, weighx, xincr,  zweinor, xk, xl, xm
     80  REAL    :: rad, zdeltay, zleny, weighy, masque, zweisud, xp, xq, xw
     81
     82
     83
    8584!-------------------------------------------------------------------------------
    8685  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
    … …  
    170169    DO jj = 1, jmar
    171170      DO j = 2,jmdp+1
    172         zlenx  =zleny  *COS(yusn(j))
     171        zlenx=zleny*COS(yusn(j))
    173172        zdeltax=zdeltay*COS(yusn(j))
    174         zbordnor=(xincr+c(jj)-yusn(j))*rad
    175         zbordsud=(xincr-d(jj)+yusn(j))*rad
    176         weighy=AMAX1(0.,AMIN1(zbordnor,zbordsud,zleny))
     173        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
     174        weighy=AMAX1(0.,AMIN1(weighy,zleny))
     175
    177176        IF(weighy==0.) CYCLE
    178177        DO i = 2, imdp+2*iext-1
    179           zbordest=(xusn(i)-a(ii)+xincr)*rad*COS(yusn(j))
    180           zbordoue=(b(ii)+xincr-xusn(i))*rad*COS(yusn(j))
    181           weighx=AMAX1(0.,AMIN1(zbordest,zbordoue,zlenx))
     178          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
     179          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
     180
    182181          IF(weighx==0.) CYCLE
    183182          num_tot(ii,jj)=num_tot(ii,jj)+1.0
    … …  
    198197!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
    199198  IF(.NOT.masque_lu) THEN
    200     WHERE(weight(:,1:jmar-1)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
     199    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
    201200  END IF
    202   nn=COUNT(weight(:,1:jmar-1)==0.0)
     201  nn=COUNT(weight(:,:)==0.0)
    203202  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
    204203  WHERE(weight(:,:)/=0.0)
    … …  
    224223!--- FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
    225224!-------------------------------------------------------------------------------
    226   ALLOCATE(zmea0(imar+1,jmar))
    227   zmea0(:,:)=zmea(:,:)                           ! GK211005 (CG) UNSMOOTHED TOPO
     225  zphi(:,:)=zmea(:,:)                           ! GK211005 (CG) UNSMOOTHED TOPO
     226
    228227  CALL MVA9(zmea);  CALL MVA9(zstd);  CALL MVA9(zpic);  CALL MVA9(zval)
    229228  CALL MVA9(zxtzx); CALL MVA9(zxtzy); CALL MVA9(zytzy)
    230229
    231230!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD. (SURFACE PARAMS MEANINGLESS)
    232   ALLOCATE(mask_tmp(imar+1,jmar)); mask_tmp(:,:)=0.0
    233   WHERE(mask>=0.1) mask_tmp = 1.
    234   WHERE(weight(:,:)/=0.0)
    235 !   zphi (:,:)= mask_tmp(:,:)*zmea (:,:) ! GK211005 (CG) not necessarly smoothed
    236     zphi (:,:)= mask_tmp(:,:)*zmea0(:,:)
    237     zmea0(:,:)= mask_tmp(:,:)*zmea0(:,:)
    238     zmea (:,:)= mask_tmp(:,:)*zmea (:,:)
    239     zpic (:,:)= mask_tmp(:,:)*zpic (:,:)
    240     zval (:,:)= mask_tmp(:,:)*zval (:,:)
    241     zstd (:,:)= mask_tmp(:,:)*zstd (:,:)
     231  WHERE(weight(:,:)==0.0.OR.mask<0.1)
     232    zphi(:,:)=0.0; zmea(:,:)=0.0; zpic(:,:)=0.0; zval(:,:)=0.0; zstd(:,:)=0.0
    242233  END WHERE
    243234  DO ii = 1, imar
    244235    DO jj = 1, jmar
    245       IF (weight(ii,jj)/=0.0) THEN
    246       !--- Coefficients K, L et M:
    247         xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
    248         xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
    249         xm=zxtzy(ii,jj)
    250         xp=xk-SQRT(xl**2+xm**2)
    251         xq=xk+SQRT(xl**2+xm**2)
    252         xw=1.e-8
    253         IF(xp<=xw) xp=0.
    254         IF(xq<=xw) xq=xw
    255         IF(ABS(xm)<=xw) xm=xw*SIGN(1.,xm)
    256       !--- SLOPE
    257         zsig(ii,jj)=SQRT(xq)*mask_tmp(ii,jj)
    258       !---ISOTROPY
    259         zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
    260       !--- THETA ANGLE
    261         zthe(ii,jj)=57.29577951*ATAN2(xm,xl)/2.*mask_tmp(ii,jj)
    262       END IF
     236      IF(weight(ii,jj)==0.0) CYCLE
     237    !--- Coefficients K, L et M:
     238      xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
     239      xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
     240      xm=zxtzy(ii,jj)
     241      xp=xk-SQRT(xl**2+xm**2)
     242      xq=xk+SQRT(xl**2+xm**2)
     243      xw=1.e-8
     244      IF(xp<=xw) xp=0.
     245      IF(xq<=xw) xq=xw
     246      IF(ABS(xm)<=xw) xm=xw*SIGN(1.,xm)
     247    !--- SLOPE, ANISOTROPY AND THETA ANGLE
     248      zsig(ii,jj)=SQRT(xq)
     249      zgam(ii,jj)=xp/xq
     250      zthe(ii,jj)=90.*ATAN2(xm,xl)/xpi
    263251    END DO
    264252  END DO
     253  WHERE(weight(:,:)==0.0.OR.mask<0.1)
     254    zsig(:,:)=0.0; zgam(:,:)=0.0; zthe(:,:)=0.0
     255  END WHERE
     256
    265257  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
    266258  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
    … …  
    271263  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
    272264     
    273 !--- Values at poles
    274   zmea0(imar+1,:)=zmea0(1,:)
    275   zmea (imar+1,:)=zmea (1,:)
    276   zphi (imar+1,:)=zphi (1,:)
    277   zpic (imar+1,:)=zpic (1,:)
    278   zval (imar+1,:)=zval (1,:)
    279   zstd (imar+1,:)=zstd (1,:)
    280   zsig (imar+1,:)=zsig (1,:)
    281   zgam (imar+1,:)=zgam (1,:)
    282   zthe (imar+1,:)=zthe (1,:)
    283 
    284   zweinor =SUM(weight(1:imar,   1),DIM=1)
    285   zweisud =SUM(weight(1:imar,jmar),DIM=1)
    286   zmeanor0=SUM(weight(1:imar,   1)*zmea0(1:imar,   1),DIM=1)
    287   zmeasud0=SUM(weight(1:imar,jmar)*zmea0(1:imar,jmar),DIM=1)
    288   zmeanor =SUM(weight(1:imar,   1)*zmea (1:imar,   1),DIM=1)
    289   zmeasud =SUM(weight(1:imar,jmar)*zmea (1:imar,jmar),DIM=1)
    290   zstdnor =SUM(weight(1:imar,   1)*zstd (1:imar,   1),DIM=1)
    291   zstdsud =SUM(weight(1:imar,jmar)*zstd (1:imar,jmar),DIM=1)
    292   zsignor =SUM(weight(1:imar,   1)*zsig (1:imar,   1),DIM=1)
    293   zsigsud =SUM(weight(1:imar,jmar)*zsig (1:imar,jmar),DIM=1)
    294   zpicnor =SUM(weight(1:imar,   1)*zpic (1:imar,   1),DIM=1)
    295   zpicsud =SUM(weight(1:imar,jmar)*zpic (1:imar,jmar),DIM=1)
    296   zvalnor =SUM(weight(1:imar,   1)*zval (1:imar,   1),DIM=1)
    297   zvalsud =SUM(weight(1:imar,jmar)*zval (1:imar,jmar),DIM=1)
    298 
    299   zmea(:,1)=zmeanor /zweinor; zmea(:,jmar)=zmeasud /zweisud
    300 !  zphi(:,1)=zmeanor0/zweinor; zphi(:,jmar)=zmeasud0/zweisud   TO COMMIT
    301   zphi(:,1)=zmeanor /zweinor; zphi(:,jmar)=zmeasud /zweisud
    302   zpic(:,1)=zpicnor /zweinor; zpic(:,jmar)=zpicsud /zweisud
    303   zval(:,1)=zvalnor /zweinor; zval(:,jmar)=zvalsud /zweisud
    304   zstd(:,1)=zstdnor /zweinor; zstd(:,jmar)=zstdsud /zweisud
    305   zsig(:,1)=zsignor /zweinor; zsig(:,jmar)=zsigsud /zweisud
    306   zgam(:,1)=1.;               zgam(:,jmar)=1.
    307   zthe(:,1)=0.;               zthe(:,jmar)=0.
     265!--- Values at redundant longitude
     266  zmea(imar+1,:)=zmea(1,:)
     267  zphi(imar+1,:)=zphi(1,:)
     268  zpic(imar+1,:)=zpic(1,:)
     269  zval(imar+1,:)=zval(1,:)
     270  zstd(imar+1,:)=zstd(1,:)
     271  zsig(imar+1,:)=zsig(1,:)
     272  zgam(imar+1,:)=zgam(1,:)
     273  zthe(imar+1,:)=zthe(1,:)
     274
     275!--- Values at north pole
     276  zweinor  =SUM(weight(1:imar,1))
     277  zmea(:,1)=SUM(weight(1:imar,1)*zmea(1:imar,1))/zweinor
     278  zphi(:,1)=SUM(weight(1:imar,1)*zphi(1:imar,1))/zweinor
     279  zpic(:,1)=SUM(weight(1:imar,1)*zpic(1:imar,1))/zweinor
     280  zval(:,1)=SUM(weight(1:imar,1)*zval(1:imar,1))/zweinor
     281  zstd(:,1)=SUM(weight(1:imar,1)*zstd(1:imar,1))/zweinor
     282  zsig(:,1)=SUM(weight(1:imar,1)*zsig(1:imar,1))/zweinor
     283  zgam(:,1)=1.; zthe(:,1)=0.
     284
     285!--- Values at south pole
     286  zweisud     =SUM(weight(1:imar,jmar),DIM=1)
     287  zmea(:,jmar)=SUM(weight(1:imar,jmar)*zmea(1:imar,jmar))/zweisud
     288  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/zweisud
     289  zpic(:,jmar)=SUM(weight(1:imar,jmar)*zpic(1:imar,jmar))/zweisud
     290  zval(:,jmar)=SUM(weight(1:imar,jmar)*zval(1:imar,jmar))/zweisud
     291  zstd(:,jmar)=SUM(weight(1:imar,jmar)*zstd(1:imar,jmar))/zweisud
     292  zsig(:,jmar)=SUM(weight(1:imar,jmar)*zsig(1:imar,jmar))/zweisud
     293  zgam(:,jmar)=1.; zthe(:,jmar)=0.
    308294
    309295END SUBROUTINE grid_noro
    … …  
    323309!-------------------------------------------------------------------------------
    324310! Arguments:
    325   REAL, INTENT(IN)   :: xd(:), yd(:) !--- INPUT  COORDINATES     (imdp) (jmdp)
    326   REAL, INTENT(IN)   :: zd(:,:)      !--- INPUT  FIELD           (imdp,jmdp)
    327   REAL, INTENT(IN)   :: x(:), y(:)   !--- OUTPUT COORDINATES     (imar+1) (jmar)
    328   REAL, INTENT(OUT)  :: zphi(:,:)    !--- GEOPOTENTIAL           (imar+1,jmar)
    329   REAL, INTENT(INOUT):: mask(:,:)    !--- MASK                   (imar+1,jmar)
     311  REAL, INTENT(IN)  :: xd(:), yd(:) !--- INPUT  COORDINATES     (imdp) (jmdp)
     312  REAL, INTENT(IN)  :: zd(:,:)      !--- INPUT  FIELD           (imdp,  jmdp)
     313  REAL, INTENT(IN)  :: x(:), y(:)   !--- OUTPUT COORDINATES     (imar+1) (jmar)
     314  REAL, INTENT(OUT) :: zphi(:,:)    !--- GEOPOTENTIAL           (imar+1,jmar)
     315  REAL, INTENT(OUT) :: mask(:,:)    !--- MASK                   (imar+1,jmar)
    330316!-------------------------------------------------------------------------------
    331317! Local variables:
    332318  CHARACTER(LEN=256) :: modname="grid_noro0"
    333319  REAL, ALLOCATABLE :: xusn(:), yusn(:)           ! dim (imdp+2*iext) (jmdp+2)
    334   REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,jmdp+2)
     320  REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,  jmdp+2)
    335321  REAL, ALLOCATABLE :: weight(:,:)                ! dim (imar+1,jmar)
    336   REAL, ALLOCATABLE :: mask_tmp(:,:), zmea(:,:)  ! dim (imar+1,jmar)
    337   REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imax,jmax)
    338   REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imax)
    339   REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmax)
     322  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
     323  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
     324  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
     325
    340326  LOGICAL :: masque_lu
    341327  INTEGER :: i, ii, imdp, imar, iext
    342328  INTEGER :: j, jj, jmdp, jmar, nn
    343   REAL    :: xpi, zlenx, weighx, xincr,  zbordnor, zmeanor, zweinor, zbordest
    344   REAL    :: rad, zleny, weighy, masque, zbordsud, zmeasud, zweisud, zbordoue
     329  REAL    :: xpi, zlenx, zleny, weighx, weighy, xincr, masque, rad
     330
    345331!-------------------------------------------------------------------------------
    346332  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
    … …  
    392378
    393379!--- INITIALIZATIONS:
    394   ALLOCATE(weight(imar+1,jmar)); weight(:,:)= 0.0
    395   ALLOCATE(zmea  (imar+1,jmar)); zmea  (:,:)= 0.0
     380  ALLOCATE(weight(imar+1,jmar)); weight(:,:)=0.0; zphi(:,:)=0.0
    396381
    397382!--- SUMMATION OVER GRIDPOINT AREA
    … …  
    403388    DO jj = 1, jmar
    404389      DO j = 2,jmdp+1
    405         zlenx  =zleny  *COS(yusn(j))
    406         zbordnor=(xincr+c(jj)-yusn(j))*rad
    407         zbordsud=(xincr-d(jj)+yusn(j))*rad
    408         weighy=AMAX1(0.,AMIN1(zbordnor,zbordsud,zleny))
    409         IF(weighy/=0) THEN
    410           DO i = 2, imdp+2*iext-1
    411             zbordest=(xusn(i)-a(ii)+xincr)*rad*COS(yusn(j))
    412             zbordoue=(b(ii)+xincr-xusn(i))*rad*COS(yusn(j))
    413             weighx=AMAX1(0.,AMIN1(zbordest,zbordoue,zlenx))
    414             IF(weighx/=0)THEN
    415               num_tot(ii,jj)=num_tot(ii,jj)+1.0
    416               IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
    417               weight(ii,jj)=weight(ii,jj)+weighx*weighy
    418               zmea  (ii,jj)=zmea  (ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
    419             END IF
    420           END DO
    421         END IF
     390        zlenx=zleny*COS(yusn(j))
     391        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
     392        weighy=AMAX1(0.,AMIN1(weighy,zleny))
     393        IF(weighy/=0) CYCLE
     394        DO i = 2, imdp+2*iext-1
     395          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
     396          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
     397          IF(weighx/=0) CYCLE
     398          num_tot(ii,jj)=num_tot(ii,jj)+1.0
     399          IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
     400          weight(ii,jj)=weight(ii,jj)+weighx*weighy
     401          zphi  (ii,jj)=zphi  (ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
     402        END DO
    422403      END DO
    423404    END DO
    … …  
    426407!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
    427408  IF(.NOT.masque_lu) THEN
    428     WHERE(weight(:,1:jmar-1)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
     409    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
    429410  END IF
    430   nn=COUNT(weight(:,1:jmar-1)==0.0)
     411  nn=COUNT(weight(:,:)==0.0)
    431412  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
    432   WHERE(weight/=0.0) zmea(:,:)=zmea(:,:)/weight(:,:)
     413  WHERE(weight/=0.0) zphi(:,:)=zphi(:,:)/weight(:,:)
    433414
    434415!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD (<10%: SURF PARAMS MEANINGLESS)
    435   ALLOCATE(mask_tmp(imar+1,jmar)); mask_tmp(:,:)=0.0
    436   WHERE(mask>=0.1) mask_tmp = 1.
    437   WHERE(weight(:,:)/=0.0)
    438     zphi(:,:)=mask_tmp(:,:)*zmea(:,:)
    439     zmea(:,:)=mask_tmp(:,:)*zmea(:,:)
    440   END WHERE
     416  WHERE(weight(:,:)==0.0.OR.mask<0.1) zphi(:,:)=0.0
     417  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zphi)
     418
     419!--- Values at redundant longitude and at poles
     420  zphi(imar+1,:)=zphi(1,:)
     421  zphi(:,   1)=SUM(weight(1:imar,   1)*zphi(1:imar,   1))/SUM(weight(1:imar,   1))
     422  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/SUM(weight(1:imar,jmar))
     423
     424END SUBROUTINE grid_noro0
     425!
     426!-------------------------------------------------------------------------------
     427
     428
     429!-------------------------------------------------------------------------------
     430!
     431SUBROUTINE read_noro(x,y,fname,zphi,zmea,zstd,zsig,zgam,zthe,zpic,zval,mask)
     432!
     433!-------------------------------------------------------------------------------
     434! Purpose: Read parameters usually determined with grid_noro from a file.
     435!===============================================================================
     436  USE netcdf, ONLY: NF90_OPEN,  NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION,        &
     437        NF90_NOERR, NF90_CLOSE, NF90_INQ_VARID, NF90_GET_VAR, NF90_STRERROR,   &
     438        NF90_NOWRITE
     439  IMPLICIT NONE
     440!-------------------------------------------------------------------------------
     441! Arguments:
     442  REAL, INTENT(IN)  :: x(:), y(:)    !--- OUTPUT COORDINATES     (imar+1) (jmar)
     443  CHARACTER(LEN=*), INTENT(IN) :: fname ! PARAMETERS FILE NAME
     444  REAL, INTENT(OUT) :: zphi(:,:)     !--- GEOPOTENTIAL           (imar+1,jmar)
     445  REAL, INTENT(OUT) :: zmea(:,:)     !--- MEAN OROGRAPHY         (imar+1,jmar)
     446  REAL, INTENT(OUT) :: zstd(:,:)     !--- STANDARD DEVIATION     (imar+1,jmar)
     447  REAL, INTENT(OUT) :: zsig(:,:)     !--- SLOPE                  (imar+1,jmar)
     448  REAL, INTENT(OUT) :: zgam(:,:)     !--- ANISOTROPY             (imar+1,jmar)
     449  REAL, INTENT(OUT) :: zthe(:,:)     !--- SMALL AXIS ORIENTATION (imar+1,jmar)
     450  REAL, INTENT(OUT) :: zpic(:,:)     !--- MAXIMUM ALTITUDE       (imar+1,jmar)
     451  REAL, INTENT(OUT) :: zval(:,:)     !--- MINIMUM ALTITUDE       (imar+1,jmar)
     452  REAL, INTENT(OUT) :: mask(:,:)     !--- MASK                   (imar+1,jmar)
     453!-------------------------------------------------------------------------------
     454! Local variables:
     455  CHARACTER(LEN=256) :: modname="read_noro"
     456  INTEGER :: imar, jmar, fid, did, vid
     457  LOGICAL :: masque_lu
     458  REAL :: xpi, d2r
     459!-------------------------------------------------------------------------------
     460  imar=assert_eq([SIZE(x),SIZE(zphi,1),SIZE(zmea,1),SIZE(zstd,1),SIZE(zsig,1), &
     461                          SIZE(zgam,1),SIZE(zthe,1),SIZE(zpic,1),SIZE(zval,1), &
     462                          SIZE(mask,1)],TRIM(modname)//" imar")-1
     463  jmar=assert_eq([SIZE(y),SIZE(zphi,2),SIZE(zmea,2),SIZE(zstd,2),SIZE(zsig,2), &
     464                          SIZE(zgam,2),SIZE(zthe,2),SIZE(zpic,2),SIZE(zval,2), &
     465                          SIZE(mask,2)],TRIM(modname)//" jmar")
     466  xpi=ACOS(-1.0); d2r=xpi/180.
     467  WRITE(lunout,*)"*** Orography parameters at sub-cell scale from file ***"
     468
     469!--- ARE WE USING A READ MASK ?
     470  masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0
     471  WRITE(lunout,*)'Masque lu: ',masque_lu
     472  CALL ncerr(NF90_OPEN(fname,NF90_NOWRITE,fid))
     473  CALL check_dim('x','longitude',x(1:imar))
     474  CALL check_dim('y','latitude' ,y(1:jmar))
     475  IF(.NOT.masque_lu) CALL get_fld('mask',mask)
     476  CALL get_fld('Zphi',zphi)
     477  CALL get_fld('Zmea',zmea)
     478  CALL get_fld('mu'  ,zstd)
     479  CALL get_fld('Zsig',zsig)
     480  CALL get_fld('Zgam',zgam)
     481  CALL get_fld('Zthe',zthe)
     482  zpic=zmea+2*zstd
     483  zval=MAX(0.,zmea-2.*zstd)
     484  CALL ncerr(NF90_CLOSE(fid))
    441485  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
    442 
    443 !--- Values at poles
    444   zphi(imar+1,:)=zphi(1,:)
    445 
    446   zweinor=SUM(weight(1:imar,   1),DIM=1)
    447   zweisud=SUM(weight(1:imar,jmar),DIM=1)
    448   zmeanor=SUM(weight(1:imar,   1)*zmea(1:imar,   1),DIM=1)
    449   zmeasud=SUM(weight(1:imar,jmar)*zmea(1:imar,jmar),DIM=1)
    450   zphi(:,1)=zmeanor/zweinor; zphi(:,jmar)=zmeasud/zweisud
    451 
    452 END SUBROUTINE grid_noro0
     486  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
     487  WRITE(lunout,*)'  PENTE:'    ,MAXVAL(zsig)
     488  WRITE(lunout,*)'  ANISOTROP:',MAXVAL(zgam)
     489  WRITE(lunout,*)'  ANGLE:'    ,MINVAL(zthe),MAXVAL(zthe)
     490  WRITE(lunout,*)'  pic:'      ,MAXVAL(zpic)
     491  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
     492
     493CONTAINS
     494
     495
     496SUBROUTINE get_fld(var,fld)
     497  CHARACTER(LEN=*), INTENT(IN)    :: var
     498  REAL,             INTENT(INOUT) :: fld(:,:)
     499  CALL ncerr(NF90_INQ_VARID(fid,var,vid),var)
     500  CALL ncerr(NF90_GET_VAR(fid,vid,fld(1:imar,:)),var)
     501  fld(imar+1,:)=fld(1,:)
     502END SUBROUTINE get_fld
     503
     504SUBROUTINE check_dim(dimd,nam,dimv)
     505  CHARACTER(LEN=*), INTENT(IN) :: dimd
     506  CHARACTER(LEN=*), INTENT(IN) :: nam
     507  REAL,             INTENT(IN) :: dimv(:)
     508  REAL, ALLOCATABLE :: tmp(:)
     509  INTEGER :: n
     510  CALL ncerr(NF90_INQ_DIMID(fid,dimd,did))
     511  CALL ncerr(NF90_INQUIRE_DIMENSION(fid,did,len=n)); ALLOCATE(tmp(n))
     512  CALL ncerr(NF90_INQ_VARID(fid,dimd,did))
     513  CALL ncerr(NF90_GET_VAR(fid,did,tmp))
     514  IF(MAXVAL(tmp)>xpi) tmp=tmp*d2r
     515  IF(n/=SIZE(dimv).OR.ANY(ABS(tmp-dimv)>1E-6)) THEN
     516    WRITE(lunout,*)'Problem with file "'//TRIM(fname)//'".'
     517    CALL abort_physic(modname,'Grid differs from LMDZ for '//TRIM(nam)//'.',1)
     518  END IF
     519END SUBROUTINE check_dim
     520
     521SUBROUTINE ncerr(ncres,var)
     522  IMPLICIT NONE
     523  INTEGER,          INTENT(IN) :: ncres
     524  CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: var
     525  CHARACTER(LEN=256) :: mess
     526  IF(ncres/=NF90_NOERR) THEN
     527    mess='Problem with file "'//TRIM(fname)//'"'
     528    IF(PRESENT(var)) mess=TRIM(mess)//' and variable "'//TRIM(var)//'"'
     529    WRITE(lunout,*)TRIM(mess)//'.'
     530    CALL abort_physic(modname,NF90_STRERROR(ncres),1)
     531  END IF
     532END SUBROUTINE ncerr
     533
     534END SUBROUTINE read_noro
    453535!
    454536!-------------------------------------------------------------------------------
    … …  
    494576END MODULE grid_noro_m
    495577
     578

  • LMDZ5/trunk/libf/phylmd/limit_read_mod.F90

    r2311 r2665  
    148148    USE netcdf
    149149    USE indice_sol_mod
     150    USE phys_cal_mod, ONLY : calend, year_len
     151    USE print_control_mod, ONLY: lunout, prt_level
    150152
    151153    IMPLICIT NONE
    … …  
    170172! Locals variables
    171173!****************************************************************************************
    172     INTEGER                                   :: nid, nvarid
     174    INTEGER                                   :: nid, nvarid, ndimid, nn
    173175    INTEGER                                   :: ii, ierr
    174176    INTEGER, DIMENSION(2)                     :: start, epais
    … …  
    178180    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
    179181    CHARACTER(len=20)                         :: modname='limit_read_mod'     
     182    CHARACTER(LEN=99)                         :: abort_message, calendar, str
    180183
    181184! End declaration
    … …  
    207210! 1) Open the file limit.nc if it is the right moment to read, once a day.
    208211!    The file is read only by the master thread of the master mpi process(is_mpi_root)
     212!    Check by the way if the number of records is correct.
    209213!
    210214!****************************************************************************************
    … …  
    220224          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
    221225               'Pb d''ouverture du fichier de conditions aux limites',1)
    222          
     226
     227          !--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ
     228          ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid)
     229          ierr=NF90_GET_ATT(nid, nvarid, 'calendar', calendar)
     230          IF(ierr==NF90_NOERR.AND.calendar/=calend.AND.prt_level>=1) THEN
     231             WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: '
     232             WRITE(lunout,*)'  '//TRIM(calend)//' for gcm'
     233             WRITE(lunout,*)'  '//TRIM(calendar)//' for limit.nc file'
     234          END IF
     235
     236          !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
     237          ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     238          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
     239          WRITE(str,'(i)')nn; str=ADJUSTL(str)
     240          abort_message='limit.nc records number ('//TRIM(str)//') does'//&
     241            ' not match year length ('
     242          WRITE(str,'(i)')year_len; str=ADJUSTL(str)
     243          abort_message=TRIM(abort_message)//TRIM(str)//')'
     244          IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
     245
     246          !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
     247          ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     248          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
     249          WRITE(str,'(i)')nn; str=ADJUSTL(str)
     250          abort_message='limit.nc horizontal number of cells ('//TRIM(str)//') does'//&
     251            ' not match LMDZ klon_glo ('
     252          WRITE(str,'(i)')klon_glo; str=ADJUSTL(str)
     253          abort_message=TRIM(abort_message)//TRIM(str)//')'
     254          IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1)
     255
    223256          ! La tranche de donnees a lire:
    224257          start(1) = 1

  • LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90

    r2656 r2665  
    12041204  TYPE(ctrl_out), SAVE :: o_ep = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    12051205    'ep', 'ep', 'su', (/ ('', i=1, 9) /))
     1206  TYPE(ctrl_out), SAVE :: o_duphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1207    'duphy', 'Physics du', 'm/s2', (/ ('', i=1, 9) /))
    12061208  TYPE(ctrl_out), SAVE :: o_dtphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    12071209    'dtphy', 'Physics dT', 'K/s', (/ ('', i=1, 9) /))

  • LMDZ5/trunk/libf/phylmd/phys_output_mod.F90

    r2551 r2665  
    3232       new_aod, aerosol_couple, flag_aerosol_strat, &
    3333       pdtphys, paprs, pphis, pplay, lmax_th, ptconv, ptconvth, ivap, &
    34        d_t, qx, d_qx, zmasse, ok_sync)   
     34       d_u, d_t, qx, d_qx, zmasse, ok_sync)   
    3535
    3636    USE iophy
    … …  
    6565    REAL, INTENT(IN)                            :: pdtphys
    6666    REAL, DIMENSION(klon), INTENT(IN)           :: pphis
    67     REAL, DIMENSION(klon, klev), INTENT(IN)     :: pplay, d_t
     67    REAL, DIMENSION(klon, klev), INTENT(IN)     :: pplay, d_u, d_t
    6868    REAL, DIMENSION(klon, klev+1), INTENT(IN)   :: paprs
    6969    REAL, DIMENSION(klon,klev,nqtot), INTENT(IN):: qx, d_qx

  • LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90

    r2656 r2665  
    1919       ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync, &
    2020       ptconv, read_climoz, clevSTD, ptconvth, &
    21        d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
     21       d_u, d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
    2222
    2323    ! This subroutine does the actual writing of diagnostics that were
    … …  
    122122         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    123123         o_rnebls, o_rhum, o_ozone, o_ozone_light, &
    124          o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
     124         o_duphy, o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
    125125         o_dqsphy, o_dqsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
    126126         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
    … …  
    336336    REAL, DIMENSION(klon,nlevSTD) :: zx_tmp_fi3d_STD
    337337    REAL, DIMENSION(klon) :: pphis
    338     REAL, DIMENSION(klon, klev) :: pplay, d_t
     338    REAL, DIMENSION(klon, klev) :: pplay, d_u, d_t
    339339    REAL, DIMENSION(klon, klev+1) :: paprs
    340340    REAL, DIMENSION(klon,klev,nqtot) :: qx, d_qx
    … …  
    12141214       ENDIF
    12151215
     1216       CALL histwrite_phy(o_duphy, d_u)
     1217
    12161218       CALL histwrite_phy(o_dtphy, d_t)
    12171219

  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2661 r2665  
    15401540            flag_aerosol_strat, pdtphys, paprs, pphis,  &
    15411541            pplay, lmax_th, ptconv, ptconvth, ivap,  &
    1542             d_t, qx, d_qx, zmasse, ok_sync_omp)
     1542            d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
    15431543       !$OMP END MASTER
    15441544       !$OMP BARRIER
    … …  
    45214521         ok_ade, ok_aie, ivap, iliq, isol, new_aod,      &
    45224522         ok_sync, ptconv, read_climoz, clevSTD,          &
    4523          ptconvth, d_t, qx, d_qx, zmasse,                &
     4523         ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
    45244524         flag_aerosol, flag_aerosol_strat, ok_cdnc)
    45254525#endif
Note: See TracChangeset for help on using the changeset viewer.