Changeset 3883 for dynamico_lmdz


Ignore:
Timestamp:
Jan 12, 2016, 5:50:28 PM (9 years ago)
Author:
ymipsl
Message:

Etat0 and limit files can be now safely generated using standard lmdz dynamic or dynamico.

YM

Location:
dynamico_lmdz/aquaplanet/LMDZ5/libf
Files:
8 added
1 edited

Legend:

Unmodified
Added
Removed

  • dynamico_lmdz/aquaplanet/LMDZ5/libf/dynlonlat_phylonlat/phylmd/ce0l.F90

    r3809 r3883  
     1PROGRAM ce0l
    12!
    2 ! $Id: ce0l.F90 2248 2015-03-25 18:04:54Z lguez $
    3 !
    4 !-------------------------------------------------------------------------------
    5 !
    6 PROGRAM ce0l
    7 !-------------------------------------------------------------------------------
    8 ! Purpose: Calls etat0, creates initial states and limit_netcdf
    9 !
    10 !     interbar=.T. for barycentric interpolation inter_barxy
    11 !     extrap  =.T. for data extrapolation, like for the SSTs when file does not
    12 !                  contain ocean points only.
    13 !     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
    14 !     masque is created in etat0, passed to limit to ensure consistancy.
    15 !-------------------------------------------------------------------------------
    16   USE control_mod
    17 #ifdef CPP_EARTH
    18 ! This prog. is designed to work for Earth
    19   USE dimphy
    20   USE comgeomphy
    21   USE infotrac
    22   USE indice_sol_mod
    23 
     3!-------------------------------------------------------------------------------
     4! Purpose: Initial states and boundary conditions files creation:
     5!     * start.nc    for dynamics    (using etat0dyn     routine)
     6!     * startphy.nc for physics     (using etat0phys    routine)
     7!     * limit.nc    for forced runs (using limit_netcdf routine)
     8!-------------------------------------------------------------------------------
     9! Notes:
     10!     * extrap=.T. (default) for data extrapolation, like for the SSTs when file
     11!                   does contain ocean points only.
     12!     * "masque" can be:
     13!       - read from file "o2a.nc"          (for coupled runs).
     14!       - created in etat0phys or etat0dyn (for forced  runs).
     15!     It is then passed to limit_netcdf to ensure consistancy.
     16!-------------------------------------------------------------------------------
     17  USE ioipsl, ONLY: ioconf_calendar, getin, flininfo, flinopen, flinget, flinclo
     18  USE control_mod,    ONLY: day_step, dayref, nsplit_phys
     19  USE etat0dyn,       ONLY: etat0dyn_netcdf
     20  USE etat0phys,      ONLY: etat0phys_netcdf
     21  USE limit,          ONLY: limit_netcdf
     22  USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
     23  USE infotrac,       ONLY: type_trac, infotrac_init
     24  USE dimphy,         ONLY: klon
     25  USE test_disvert_m, ONLY: test_disvert
     26  USE filtreg_mod,    ONLY: inifilr
     27!  USE iniphysiq_mod,  ONLY: iniphysiq
     28  USE mod_const_mpi,  ONLY: comm_lmdz
     29#ifdef inca
     30  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic
     31#endif
     32#ifdef CPP_PARA
     33  USE mod_const_mpi,  ONLY: init_const_mpi
     34  USE parallel_lmdz,  ONLY: init_parallel, mpi_rank, omp_rank, mpi_size
     35  USE bands,          ONLY: read_distrib, distrib_phys
     36  USE mod_hallo,      ONLY: init_mod_hallo
     37  USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys
     38#endif
     39
     40  IMPLICIT NONE
     41
     42!-------------------------------------------------------------------------------
     43! Local variables:
     44  include "dimensions.h"
     45  include "paramet.h"
     46  include "comgeom2.h"
     47  include "comconst.h"
     48  include "comvert.h"
     49  include "iniprint.h"
     50  include "temps.h"
     51  include "logic.h"
     52  REAL               :: masque(iip1,jjp1)             !--- CONTINENTAL MASK
     53  REAL               :: phis  (iip1,jjp1)             !--- GROUND GEOPOTENTIAL
     54  CHARACTER(LEN=256) :: modname, fmt, calnd           !--- CALENDAR TYPE
     55  LOGICAL            :: use_filtre_fft
     56  LOGICAL, PARAMETER :: extrap=.FALSE.
     57
     58!--- Local variables for ocean mask reading:
     59  INTEGER            :: nid_o2a, iml_omask, jml_omask, j
     60  INTEGER            :: fid, iret, llm_tmp, ttm_tmp, itaul(1)
     61  REAL, ALLOCATABLE  :: lon_omask(:,:), dlon_omask(:), ocemask(:,:)
     62  REAL, ALLOCATABLE  :: lat_omask(:,:), dlat_omask(:), ocetmp (:,:)
     63  REAL               :: date, lev(1)
     64#ifndef CPP_PARA
     65! for iniphysiq in serial mode
     66  INTEGER,PARAMETER :: mpi_rank=0
     67  INTEGER :: distrib_phys(mpi_rank:mpi_rank)=(jjm-1)*iim+2
     68#endif
     69!-------------------------------------------------------------------------------
     70  modname="ce0l"
     71
     72!--- Constants
     73  pi     = 4. * ATAN(1.)
     74  rad    = 6371229.
     75  daysec = 86400.
     76  omeg   = 2.*pi/daysec
     77  g      = 9.8
     78  kappa  = 0.2857143
     79  cpp    = 1004.70885
     80  jmp1   = jjm + 1
     81  preff   = 101325.
     82  pa      = 50000.
     83
     84  CALL conf_gcm( 99, .TRUE. )
     85  dtvr = daysec/REAL(day_step)
     86  WRITE(lunout,*)'dtvr',dtvr
     87  CALL iniconst()
     88  CALL inigeom()
     89
     90!--- Calendar choice
    2491#ifdef CPP_IOIPSL
    25   USE ioipsl, ONLY: ioconf_calendar, getin
    26 #else
    27   ! if not using IOIPSL, we still need to use (a local version of) getin
    28   use ioipsl_getincom, only: getin
    29 #endif
    30 
    31 #endif
    32   IMPLICIT NONE
    33 #ifndef CPP_EARTH
    34 #include "iniprint.h"
    35   WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
    36 #else
    37 !-------------------------------------------------------------------------------
    38 ! Local variables:
    39   LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
    40 #include "dimensions.h"
    41 #include "paramet.h"
    42 !#include "indicesol.h"
    43 #include "iniprint.h"
    44 #include "temps.h"
    45 #include "logic.h"
    46   REAL,    DIMENSION(iip1,jjp1) :: masque
    47   CHARACTER(LEN=15)             :: calnd
    48   REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
    49   logical use_filtre_fft
    50 !-------------------------------------------------------------------------------
    51   CALL conf_gcm( 99, .TRUE. )
    52 
    53   use_filtre_fft=.FALSE.
    54   CALL getin('use_filtre_fft',use_filtre_fft)
    55   IF (use_filtre_fft) THEN
    56      write(lunout, fmt = *) 'FFT filter is not available in the ' &
    57           // 'sequential version of the dynamics.'
    58      write(lunout, fmt = *) &
    59           "Your setting of variable use_filtre_fft is not used."
    60   ENDIF
    61 
    62   CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    63   WRITE(lunout,*)'---> klon=',klon
    64   CALL InitComgeomphy
    65 
    66 #ifdef CPP_IOIPSL
     92  calnd='gregorian'
    6793  SELECT CASE(calend)
    68     CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
    69     CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
    70     CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
    71     CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
    72     CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
    73     CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
     94    CASE('earth_360d');CALL ioconf_calendar('360d');   calnd='with 360 days/year'
     95    CASE('earth_365d');CALL ioconf_calendar('noleap'); calnd='with no leap year'
     96    CASE('earth_366d');CALL ioconf_calendar('366d');   calnd='with leap years only'
     97    CASE('gregorian'); CALL ioconf_calendar('gregorian')
     98    CASE('standard');  CALL ioconf_calendar('gregorian')
     99    CASE('julian');    CALL ioconf_calendar('julian'); calnd='julian'
    74100    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
    75101  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
    76102    CASE DEFAULT
    77       CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
     103      CALL abort_gcm('ce0l','Bad choice for calendar',1)
    78104  END SELECT
    79   WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
    80 #endif
    81 
     105  WRITE(lunout,*)'CHOSEN CALENDAR: Earth '//TRIM(calnd)
     106#endif
     107
     108#ifdef CPP_PARA
     109!--- Physical grid + parallel initializations
     110  CALL init_const_mpi()
     111  CALL init_parallel()
     112  CALL read_distrib()
     113  CALL init_mod_hallo()
     114#endif
     115  WRITE(lunout,*)'---> klon=',klon
     116
     117!--- Tracers initializations
    82118  IF (type_trac == 'inca') THEN
    83119#ifdef INCA
    84     CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
    85     CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
     120    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday,&
     121                         nbsrf,is_oce,is_sic,is_ter,is_lic,calend)
     122    CALL init_inca_para(iim,jjp1,llm,klon_glo,mpi_size,distrib_phys,&
     123                        COMM_LMDZ)
    86124    WRITE(lunout,*)'nbtr =' , nbtr
    87125#endif
    88126  END IF
    89 
    90   WRITE(lunout,'(//)')
    91   WRITE(lunout,*) '  *********************  '
    92   WRITE(lunout,*) '  ***  etat0_netcdf ***  '
    93   WRITE(lunout,*) '  *********************  '
    94   WRITE(lunout,'(//)')
    95   WRITE(lunout,*) ' interbar = ',interbar
    96   CALL etat0_netcdf(interbar,masque,phis,ok_etat0)
     127  CALL infotrac_init()
     128
     129  CALL inifilr()
     130  CALL iniphysiq(iim,jjm, &
     131                 distrib_phys(mpi_rank),comm_lmdz, llm, &
     132                 daysec,dtphys/nsplit_phys, &
     133                 rlatu,rlatv,rlonu,rlonv,aire,cu,cv,rad,g,r,cpp,iflag_phys)
     134  IF(pressure_exner) CALL test_disvert
     135
     136#ifdef CPP_PARA
     137  IF (mpi_rank==0.AND.omp_rank==0) THEN
     138#endif
     139  use_filtre_fft=.FALSE.
     140  CALL getin('use_filtre_fft',use_filtre_fft)
     141  IF(use_filtre_fft) THEN
     142     WRITE(lunout,*)"FFT filter not available for sequential dynamics."
     143     WRITE(lunout,*)"Your setting of variable use_filtre_fft is not used."
     144  ENDIF
     145
     146!--- LAND MASK. TWO CASES:
     147!   1) read from ocean model    file "o2a.nc"    (coupled runs)
     148!   2) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
     149! Coupled simulations (case 1) use the ocean model mask to compute the
     150! weights to ensure ocean fractions are the same for atmosphere and ocean.
     151!*******************************************************************************
     152  IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)/=NF90_NOERR) THEN
     153    WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file found'
     154    WRITE(lunout,*)'Forced run.'
     155    masque(:,:)=-99999.
     156  ELSE
     157    iret=NF90_CLOSE(nid_o2a)
     158    WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found'
     159    WRITE(lunout,*)'Coupled run.'
     160    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
     161    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
     162      WRITE(lunout,*)'Mismatching dimensions for ocean mask'
     163      WRITE(lunout,*)'iim  = ',iim ,' iml_omask = ',iml_omask
     164      WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
     165      CALL abort_gcm(modname,'',1)
     166    END IF
     167    ALLOCATE(ocemask(iim,jjp1),lon_omask(iim,jjp1),dlon_omask(iim ))
     168    ALLOCATE(ocetmp (iim,jjp1),lat_omask(iim,jjp1),dlat_omask(jjp1))
     169    CALL flinopen("o2a.nc", .FALSE.,iml_omask,jml_omask,llm_tmp,               &
     170                  lon_omask,lat_omask,lev,ttm_tmp,itaul,date,dt,fid)
     171    CALL flinget(fid, "OceMask",    iim,jjp1,llm_tmp,ttm_tmp,1,1,ocetmp)
     172    CALL flinclo(fid)
     173    dlon_omask(1:iim ) = lon_omask(1:iim,1)
     174    dlat_omask(1:jjp1) = lat_omask(1,1:jjp1)
     175    ocemask = ocetmp
     176    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
     177      DO j=1,jjp1; ocemask(:,j) = ocetmp(:,jjp1-j+1); END DO
     178    END IF
     179    DEALLOCATE(ocetmp,lon_omask,lat_omask,dlon_omask,dlat_omask)
     180    IF(prt_level>=1) THEN
     181      WRITE(fmt,"(i4,'i1)')")iim ; fmt='('//ADJUSTL(fmt)
     182      WRITE(lunout,*)'OCEAN MASK :'
     183      WRITE(lunout,fmt) NINT(ocemask)
     184    END IF
     185    masque(1:iim,:)=1.-ocemask(:,:)
     186    masque(iip1 ,:)=masque(1,:)
     187    DEALLOCATE(ocemask)
     188  END IF
     189  phis(:,:)=-99999.
     190
     191  IF(ok_etat0) THEN
     192    WRITE(lunout,'(//)')
     193    WRITE(lunout,*) '  ************************  '
     194    WRITE(lunout,*) '  ***  etat0phy_netcdf ***  '
     195    WRITE(lunout,*) '  ************************  '
     196    CALL etat0phys_netcdf(masque,phis)
     197    WRITE(lunout,'(//)')
     198    WRITE(lunout,*) '  ************************  '
     199    WRITE(lunout,*) '  ***  etat0dyn_netcdf ***  '
     200    WRITE(lunout,*) '  ************************  '
     201    CALL etat0dyn_netcdf(masque,phis)
     202  END IF
    97203
    98204  IF(ok_limit) THEN
    99   WRITE(lunout,'(//)')
    100   WRITE(lunout,*) '  *********************  '
    101   WRITE(lunout,*) '  ***  Limit_netcdf ***  '
    102   WRITE(lunout,*) '  *********************  '
    103   WRITE(lunout,'(//)')
    104   CALL limit_netcdf(interbar,extrap,oldice,masque)
    105   END IF
    106 
    107  
     205    WRITE(lunout,'(//)')
     206    WRITE(lunout,*) '  *********************  '
     207    WRITE(lunout,*) '  ***  Limit_netcdf ***  '
     208    WRITE(lunout,*) '  *********************  '
     209    WRITE(lunout,'(//)')
     210    CALL limit_netcdf(masque,phis,extrap)
     211  END IF
     212
    108213  WRITE(lunout,'(//)')
    109214  WRITE(lunout,*) '  ***************************  '
    … …  
    113218  CALL grilles_gcm_netcdf_sub(masque,phis)
    114219
    115 #endif
    116 ! of #ifndef CPP_EARTH #else
     220#ifdef CPP_PARA
     221  END IF
     222#endif
    117223
    118224END PROGRAM ce0l
Note: See TracChangeset for help on using the changeset viewer.