New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5572 for branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

Ignore:
Timestamp:
2015-07-09T12:14:37+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO/dev_r5107_hadgem3_cplseq branch to trunk revision 5518
(= branching point of NEMO 3.6_stable).

Location:
branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5477 r5572  
    2626   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename 
    2727   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input) 
     28   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory 
    2829   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output) 
     30   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory 
    2931   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file 
     32   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F) 
    3033   INTEGER       ::   nn_no            !: job number 
    3134   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2) 
     
    3841   INTEGER       ::   nn_write         !: model standard output frequency 
    3942   INTEGER       ::   nn_stock         !: restart file frequency 
     43   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times 
    4044   LOGICAL       ::   ln_dimgnnn       !: type of dimgout. (F): 1 file for all proc 
    4145                                                       !:                  (T): 1 file per proc 
    4246   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%) 
     47   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard 
    4348   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file 
    4449   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
     
    7883   INTEGER       ::   nwrite                      !: model standard output frequency 
    7984   INTEGER       ::   nstock                      !: restart file frequency 
     85   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times 
    8086 
    8187   !!---------------------------------------------------------------------- 
     
    8490   INTEGER ::   nitrst                !: time step at which restart file should be written 
    8591   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    86    INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
     92   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
     93   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
     94   INTEGER ::   nrst_lst              !: number of restart to output next 
    8795 
    8896   !!---------------------------------------------------------------------- 
     
    142150   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
    143151   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
     152   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    144153 
    145154   !!---------------------------------------------------------------------- 
  • branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5477 r5572  
    3333   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes 
    3434#if defined key_lim3 
    35    USE par_ice 
     35   USE ice    , ONLY :   jpl 
    3636#elif defined key_lim2 
    3737   USE par_ice_2 
     
    6161#if defined key_iomput 
    6262   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 
    63    PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
     63   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
    6464# endif 
    6565 
     
    9898      CHARACTER(len=10) :: clname 
    9999      INTEGER           ::   ji 
    100       !!---------------------------------------------------------------------- 
     100      ! 
     101      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
     102      !!---------------------------------------------------------------------- 
     103 
     104      ALLOCATE( z_bnds(jpk,2) ) 
    101105 
    102106      clname = cdname 
    103107      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 
    104 # if defined key_mpp_mpi 
    105108      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
    106 # else 
    107       CALL xios_context_initialize(TRIM(clname), 0) 
    108 # endif 
    109109      CALL iom_swap( cdname ) 
    110110 
     
    121121      CALL set_scalar 
    122122 
    123       IF( TRIM(cdname) == "nemo" ) THEN   
     123      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    124124         CALL set_grid( "T", glamt, gphit )  
    125125         CALL set_grid( "U", glamu, gphiu ) 
    126126         CALL set_grid( "V", glamv, gphiv ) 
    127127         CALL set_grid( "W", glamt, gphit ) 
    128       ENDIF 
    129  
    130       IF( TRIM(cdname) == "nemo_crs" ) THEN   
     128         CALL set_grid_znl( gphit ) 
     129         ! 
     130         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
     131            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 
     132            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 
     133            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) 
     134            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej)) 
     135            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
     136            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
     137            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
     138            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
     139         ENDIF 
     140      ENDIF 
     141 
     142      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    131143         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    132144         ! 
     
    135147         CALL set_grid( "V", glamv_crs, gphiv_crs )  
    136148         CALL set_grid( "W", glamt_crs, gphit_crs )  
     149         CALL set_grid_znl( gphit_crs ) 
    137150          ! 
    138151         CALL dom_grid_glo   ! Return to parent grid domain 
    139       ENDIF 
    140  
     152         ! 
     153         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
     154            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     155            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
     156            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 
     157            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     158            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
     159            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
     160            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs ) 
     161            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
     162         ENDIF 
     163      ENDIF 
    141164 
    142165      ! vertical grid definition 
     
    145168      CALL iom_set_axis_attr( "depthv", gdept_1d ) 
    146169      CALL iom_set_axis_attr( "depthw", gdepw_1d ) 
     170 
     171      ! Add vertical grid bounds 
     172      z_bnds(:      ,1) = gdepw_1d(:) 
     173      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
     174      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     175      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
     176      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
     177      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
     178      z_bnds(:    ,2) = gdept_1d(:) 
     179      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
     180      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     181      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     182 
    147183# if defined key_floats 
    148184      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
     
    152188#endif 
    153189      CALL iom_set_axis_attr( "icbcla", class_num ) 
     190      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
     191      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 
    154192       
    155193      ! automatic definitions of some of the xml attributs 
     
    162200       
    163201      CALL xios_update_calendar(0) 
     202 
     203      DEALLOCATE( z_bnds ) 
     204 
    164205#endif 
    165206       
     
    543584   END SUBROUTINE iom_g1d 
    544585 
    545    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     586   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 
    546587      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    547588      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
     
    551592      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    552593      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
     594      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     595                                                                               ! look for and use a file attribute 
     596                                                                               ! called open_ocean_jstart to set the start 
     597                                                                               ! value for the 2nd dimension (netcdf only) 
    553598      ! 
    554599      IF( kiomid > 0 ) THEN 
    555600         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    556               &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     601              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     602              &                                                     lrowattr=lrowattr ) 
    557603      ENDIF 
    558604   END SUBROUTINE iom_g2d 
    559605 
    560    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     606   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 
    561607      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    562608      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
     
    566612      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    567613      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
     614      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     615                                                                                 ! look for and use a file attribute 
     616                                                                                 ! called open_ocean_jstart to set the start 
     617                                                                                 ! value for the 2nd dimension (netcdf only) 
    568618      ! 
    569619      IF( kiomid > 0 ) THEN 
    570620         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    571               &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     621              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     622              &                                                     lrowattr=lrowattr ) 
    572623      ENDIF 
    573624   END SUBROUTINE iom_g3d 
     
    576627   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    577628         &                  pv_r1d, pv_r2d, pv_r3d,   & 
    578          &                  ktime , kstart, kcount  ) 
     629         &                  ktime , kstart, kcount,   & 
     630         &                  lrowattr                ) 
    579631      !!----------------------------------------------------------------------- 
    580632      !!                  ***  ROUTINE  iom_get_123d  *** 
     
    593645      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    594646      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
     647      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
     648                                                                           ! look for and use a file attribute 
     649                                                                           ! called open_ocean_jstart to set the start 
     650                                                                           ! value for the 2nd dimension (netcdf only) 
    595651      ! 
    596652      LOGICAL                        ::   llnoov      ! local definition to read overlap 
     653      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
     654      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute 
    597655      INTEGER                        ::   jl          ! loop on number of dimension  
    598656      INTEGER                        ::   idom        ! type of domain 
     
    604662      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
    605663      INTEGER                        ::   ji, jj      ! loop counters 
    606       INTEGER                        ::   irankpv       !  
     664      INTEGER                        ::   irankpv     !  
    607665      INTEGER                        ::   ind1, ind2  ! substring index 
    608666      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis 
     
    628686      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    629687      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 
     688 
     689      luse_jattr = .false. 
     690      IF( PRESENT(lrowattr) ) THEN 
     691         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
     692         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
     693      ENDIF 
     694      IF( luse_jattr ) THEN 
     695         SELECT CASE (iom_file(kiomid)%iolib) 
     696         CASE (jpioipsl, jprstdimg ) 
     697             CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 
     698             luse_jattr = .false. 
     699         CASE (jpnf90   )    
     700             ! Ok 
     701         CASE DEFAULT     
     702            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     703         END SELECT 
     704      ENDIF 
    630705 
    631706      ! Search for the variable in the data base (eventually actualize data) 
     
    701776            ELSE  
    702777               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    703                   IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow 
    704                   ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow 
     778                  IF(     idom == jpdom_data    ) THEN 
     779                     jstartrow = 1 
     780                     IF( luse_jattr ) THEN 
     781                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
     782                        jstartrow = MAX(1,jstartrow) 
     783                     ENDIF 
     784                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
     785                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    705786                  ENDIF 
    706787                  ! we do not read the overlap                     -> we start to read at nldi, nldj 
     
    10671148 
    10681149   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    1069       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 
    1070       CHARACTER(LEN=*)                 , INTENT(in) ::   cdid 
    1071       INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1072       INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1073       INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
    1074       REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1075       LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask 
     1150      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
     1151      &                                    nvertex, bounds_lon, bounds_lat, area ) 
     1152      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1153      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1154      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1155      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
     1156      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1157      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     1158      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    10761159 
    10771160      IF ( xios_is_valid_domain     (cdid) ) THEN 
     
    10791162            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    10801163            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1081             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1164            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
     1165            &    bounds_lat=bounds_lat, area=area ) 
    10821166      ENDIF 
    10831167 
     
    10861170            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    10871171            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1088             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1172            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
     1173            &    bounds_lat=bounds_lat, area=area ) 
    10891174      ENDIF 
    10901175      CALL xios_solve_inheritance() 
     
    10931178 
    10941179 
    1095    SUBROUTINE iom_set_axis_attr( cdid, paxis ) 
     1180   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 
    10961181      CHARACTER(LEN=*)      , INTENT(in) ::   cdid 
    1097       REAL(wp), DIMENSION(:), INTENT(in) ::   paxis 
    1098       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=size(paxis),value=paxis ) 
    1099       IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 
     1182      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis 
     1183      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
     1184      IF ( PRESENT(paxis) ) THEN 
     1185         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
     1186         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1187      ENDIF 
     1188      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
     1189      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
    11001190      CALL xios_solve_inheritance() 
    11011191   END SUBROUTINE iom_set_axis_attr 
     
    11601250      CALL iom_swap( cdname )   ! swap to cdname context 
    11611251      CALL xios_update_calendar(kt) 
    1162       IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1252      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    11631253      ! 
    11641254   END SUBROUTINE iom_setkt 
     
    11701260         CALL iom_swap( cdname )   ! swap to cdname context 
    11711261         CALL xios_context_finalize() ! finalize the context 
    1172          IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1262         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    11731263      ENDIF 
    11741264      ! 
     
    12131303 
    12141304 
     1305   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
     1306      !!---------------------------------------------------------------------- 
     1307      !!                   ***  ROUTINE set_grid_bounds  *** 
     1308      !! 
     1309      !! ** Purpose :   define horizontal grid corners 
     1310      !! 
     1311      !!---------------------------------------------------------------------- 
     1312      CHARACTER(LEN=1) , INTENT(in) :: cdgrd 
     1313      ! 
     1314      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 
     1315      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j) 
     1316      ! 
     1317      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
     1318      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells 
     1319      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells 
     1320      ! 
     1321      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1322      !                                                          ! represents the bottom-left corner of cell (i,j) 
     1323      INTEGER :: ji, jj, jn, ni, nj 
     1324 
     1325      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
     1326 
     1327      ! Offset of coordinate representing bottom-left corner 
     1328      SELECT CASE ( TRIM(cdgrd) ) 
     1329         CASE ('T', 'W') 
     1330            icnr = -1 ; jcnr = -1 
     1331         CASE ('U') 
     1332            icnr =  0 ; jcnr = -1 
     1333         CASE ('V') 
     1334            icnr = -1 ; jcnr =  0 
     1335      END SELECT 
     1336 
     1337      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
     1338 
     1339      z_fld(:,:) = 1._wp 
     1340      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     1341 
     1342      ! Cell vertices that can be defined 
     1343      DO jj = 2, jpjm1 
     1344         DO ji = 2, jpim1 
     1345            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1346            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1347            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1348            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1349            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1350            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1351            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1352            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1353         END DO 
     1354      END DO 
     1355 
     1356      ! Cell vertices on boundries 
     1357      DO jn = 1, 4 
     1358         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
     1359         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
     1360      END DO 
     1361 
     1362      ! Zero-size cells at closed boundaries if cell points provided, 
     1363      ! otherwise they are closed cells with unrealistic bounds 
     1364      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
     1365         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1366            DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
     1367               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
     1368            END DO 
     1369         ENDIF 
     1370         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1371            DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
     1372               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
     1373            END DO 
     1374         ENDIF 
     1375         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
     1376            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
     1377               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
     1378            END DO 
     1379         ENDIF 
     1380         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
     1381            DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
     1382               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
     1383            END DO 
     1384         ENDIF 
     1385      ENDIF 
     1386 
     1387      ! Rotate cells at the north fold 
     1388      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 
     1389         DO jj = 1, jpj 
     1390            DO ji = 1, jpi 
     1391               IF( z_fld(ji,jj) == -1. ) THEN 
     1392                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     1393                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     1394                  z_bnds(:,ji,jj,:) = z_rot(:,:) 
     1395               ENDIF 
     1396            END DO 
     1397         END DO 
     1398 
     1399      ! Invert cells at the symmetric equator 
     1400      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 
     1401         DO ji = 1, jpi 
     1402            z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
     1403            z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
     1404            z_bnds(:,ji,1,:) = z_rot(:,:) 
     1405         END DO 
     1406      ENDIF 
     1407 
     1408      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
     1409                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     1410 
     1411      DEALLOCATE( z_bnds, z_fld, z_rot )  
     1412 
     1413   END SUBROUTINE set_grid_bounds 
     1414 
     1415 
     1416   SUBROUTINE set_grid_znl( plat ) 
     1417      !!---------------------------------------------------------------------- 
     1418      !!                     ***  ROUTINE set_grid_znl  *** 
     1419      !! 
     1420      !! ** Purpose :   define grids for zonal mean 
     1421      !! 
     1422      !!---------------------------------------------------------------------- 
     1423      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
     1424      ! 
     1425      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
     1426      INTEGER  :: ni,nj, ix, iy 
     1427 
     1428       
     1429      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk) 
     1430      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
     1431 
     1432      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1433      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1434      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
     1435         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1436      ! 
     1437      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1438      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1439      CALL iom_update_file_name('ptr') 
     1440      ! 
     1441   END SUBROUTINE set_grid_znl 
     1442 
    12151443   SUBROUTINE set_scalar 
    12161444      !!---------------------------------------------------------------------- 
     
    12201448      !! 
    12211449      !!---------------------------------------------------------------------- 
    1222       REAL(wp), DIMENSION(1) ::   zz = 1. 
     1450      REAL(wp), DIMENSION(1)   ::   zz = 1. 
    12231451      !!---------------------------------------------------------------------- 
    12241452      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    12251453      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
     1454       
    12261455      zz=REAL(narea,wp) 
    12271456      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
     
    12961525      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 
    12971526      CALL set_mooring( zlonpira, zlatpira ) 
     1527 
    12981528       
    12991529   END SUBROUTINE set_xmlatt 
  • branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r5477 r5572  
    6161      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    6262 
    63       CHARACTER(LEN=100) ::   clinfo           ! info character 
    64       CHARACTER(LEN=100) ::   cltmp            ! temporary character 
     63      CHARACTER(LEN=256) ::   clinfo           ! info character 
     64      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
    6565      INTEGER            ::   iln              ! lengths of character 
    6666      INTEGER            ::   istop            ! temporary storage of nstop 
     
    393393      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size   
    394394      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    395       CHARACTER(LEN=100)    :: clinfo               ! info character 
     395      CHARACTER(LEN=256)    :: clinfo               ! info character 
    396396      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character 
    397397      INTEGER               :: if90id               ! nf90 file identifier 
  • branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5477 r5572  
    2424   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    26    USE sbc_ice, ONLY : lk_lim3 
    2726 
    2827   IMPLICIT NONE 
     
    5756      !! 
    5857      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    59       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     58      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name 
     59      CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file 
    6060      !!---------------------------------------------------------------------- 
    6161      ! 
    6262      IF( kt == nit000 ) THEN   ! default definitions 
    6363         lrst_oce = .FALSE.    
    64          nitrst = nitend 
    65       ENDIF 
    66       IF( MOD( kt - 1, nstock ) == 0 ) THEN    
     64         IF( ln_rst_list ) THEN 
     65            nrst_lst = 1 
     66            nitrst = nstocklist( nrst_lst ) 
     67         ELSE 
     68            nitrst = nitend 
     69         ENDIF 
     70      ENDIF 
     71 
     72      ! frequency-based restart dumping (nn_stock) 
     73      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN    
    6774         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    6875         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     
    7380      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    7481      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    75          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    76          IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    77          ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    78          ENDIF 
    79          ! create the file 
    80          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
    81          IF(lwp) THEN 
    82             WRITE(numout,*) 
    83             SELECT CASE ( jprstlib ) 
    84             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname 
    85             CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname 
    86             END SELECT 
    87             IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
    88             IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
    89             ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     82         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
     83            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     84            IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     85            ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    9086            ENDIF 
    91          ENDIF 
    92          ! 
    93          CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
    94          lrst_oce = .TRUE. 
     87            ! create the file 
     88            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
     89            clpath = TRIM(cn_ocerst_outdir) 
     90            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     91            IF(lwp) THEN 
     92               WRITE(numout,*) 
     93               SELECT CASE ( jprstlib ) 
     94               CASE ( jprstdimg )   ;   WRITE(numout,*)                            & 
     95                   '             open ocean restart binary file: ',TRIM(clpath)//clname 
     96               CASE DEFAULT         ;   WRITE(numout,*)                            & 
     97                   '             open ocean restart NetCDF file: ',TRIM(clpath)//clname 
     98               END SELECT 
     99               IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
     100               IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
     101               ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     102               ENDIF 
     103            ENDIF 
     104            ! 
     105            CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
     106            lrst_oce = .TRUE. 
     107         ENDIF 
    95108      ENDIF 
    96109      ! 
     
    120133                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    121134                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
    122                      ! 
    123       IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    124135                     ! 
    125136                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
     
    134145                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    135146#endif 
    136                   IF( lk_lim3 ) THEN 
    137                      CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    138                   ENDIF 
    139147      IF( kt == nitrst ) THEN 
    140148         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     
    142150!!gm  not sure what to do here   ===>>>  ask to Sebastian 
    143151         lrst_oce = .FALSE. 
     152            IF( ln_rst_list ) THEN 
     153               nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
     154               nitrst = nstocklist( nrst_lst ) 
     155            ENDIF 
     156            lrst_oce = .FALSE. 
    144157      ENDIF 
    145158      ! 
     
    156169      !!                the file has already been opened 
    157170      !!---------------------------------------------------------------------- 
    158       INTEGER  ::   jlibalt = jprstlib 
    159       LOGICAL  ::   llok 
     171      INTEGER        ::   jlibalt = jprstlib 
     172      LOGICAL        ::   llok 
     173      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file 
    160174      !!---------------------------------------------------------------------- 
    161175      ! 
     
    171185         ENDIF 
    172186 
     187         clpath = TRIM(cn_ocerst_indir) 
     188         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    173189         IF ( jprstlib == jprstdimg ) THEN 
    174190           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    175191           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 
    176            INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
     192           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
    177193           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    178194         ENDIF 
    179          CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt ) 
     195         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 
    180196      ENDIF 
    181197   END SUBROUTINE rst_read_open 
     
    214230         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    215231         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    216          IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    217232      ELSE 
    218233         neuler = 0 
     
    257272         ENDIF 
    258273 
    259          IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN 
    260             DO jk = 1, jpk 
    261                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
    262             END DO 
    263          ENDIF 
    264  
    265       ENDIF 
    266       ! 
    267       IF( lk_lim3 ) THEN 
    268          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    269274      ENDIF 
    270275      ! 
Note: See TracChangeset for help on using the changeset viewer.