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 5382 for branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2015-06-09T09:35:52+02:00 (9 years ago)
Author:
smasson
Message:

dev_r5218_CNRS17_coupling: merge with trunk rev 5381

Location:
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO
Files:
31 edited
3 copied

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r5123 r5382  
    2424   !                                                   !!* namicerun read in iceini  * 
    2525   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in     !: suffix of ice restart name (input) 
     26   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_indir  !: ice restart in directory 
    2627   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out    !: suffix of ice restart name (output) 
     28   CHARACTER(len=256)    , PUBLIC ::   cn_icerst_outdir !: ice restart out directory 
    2729   LOGICAL               , PUBLIC ::   ln_limdyn        !: flag for ice dynamics (T) or not (F) 
    2830   LOGICAL               , PUBLIC ::   ln_limdmp        !: Ice damping 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r4624 r5382  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 
    42    !! $Id$  
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    123123      !! ** input   :   Namelist namicerun 
    124124      !!------------------------------------------------------------------- 
    125       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 
     125      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 
     126                          ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 
    126127      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    127128      !!------------------------------------------------------------------- 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90

    r2528 r5382  
    5050      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    5151      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     52      CHARACTER(len=150)  ::   clpath   ! full path to ice output restart file 
    5253      !!---------------------------------------------------------------------- 
    5354      ! 
    … …  
    5859      ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
    5960      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    60          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    61          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    62          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     61         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     62            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     63            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     64            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     65            ENDIF 
     66            ! create the file 
     67            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     68            clpath = TRIM(cn_icerst_outdir)  
     69            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'  
     70            IF(lwp) THEN 
     71               WRITE(numout,*) 
     72               SELECT CASE ( jprstlib ) 
     73               CASE ( jprstdimg ) 
     74                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     75               CASE DEFAULT 
     76                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     77               END SELECT 
     78               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     79                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     80               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     81               ENDIF 
     82            ENDIF 
     83 
     84            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     85            lrst_ice = .TRUE. 
    6386         ENDIF 
    64          ! create the file 
    65          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    66          IF(lwp) THEN 
    67             WRITE(numout,*) 
    68             SELECT CASE ( jprstlib ) 
    69             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    70             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    71             END SELECT 
    72             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    73                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    74             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    75             ENDIF 
    76          ENDIF 
    77  
    78          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    79          lrst_ice = .TRUE. 
    8087      ENDIF 
    8188      ! 
    … …  
    188195        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    189196        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    190         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     197        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    191198        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    192199      ENDIF 
    193200 
    194       CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt ) 
     201      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt ) 
    195202 
    196203      CALL iom_get( numrir, 'kt_ice' , ziter ) 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r5167 r5382  
    373373   INTEGER          , PUBLIC ::   nlay_s          !: number of snow layers  
    374374   CHARACTER(len=32), PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input) 
     375   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
    375376   CHARACTER(len=32), PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output) 
     377   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
    376378   LOGICAL          , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    377379   LOGICAL          , PUBLIC ::   ln_icectl       !: flag for sea-ice points output (T) or not (F) 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r5128 r5382  
    5555      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5656      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     57      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file  
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    6465      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    & 
    6566         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    66          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    67          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    68          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     67         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     68            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     69            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     70            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     71            ENDIF 
     72            ! create the file 
     73            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     74            clpath = TRIM(cn_icerst_outdir)  
     75            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
     76            IF(lwp) THEN 
     77               WRITE(numout,*) 
     78               SELECT CASE ( jprstlib ) 
     79               CASE ( jprstdimg ) 
     80                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     81               CASE DEFAULT 
     82                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     83               END SELECT 
     84               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     85                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     86               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     87               ENDIF 
     88            ENDIF 
     89            ! 
     90            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     91            lrst_ice = .TRUE. 
    6992         ENDIF 
    70          ! create the file 
    71          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    72          IF(lwp) THEN 
    73             WRITE(numout,*) 
    74             SELECT CASE ( jprstlib ) 
    75             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    76             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    77             END SELECT 
    78             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    79                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    80             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    81             ENDIF 
    82          ENDIF 
    83          ! 
    84          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    85          lrst_ice = .TRUE. 
    8693      ENDIF 
    8794      ! 
    … …  
    143150         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    144151      END DO 
    145        
     152 
    146153      DO jl = 1, jpl  
    147154         WRITE(zchar,'(I1)') jl 
    … …  
    327334        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    328335        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    329         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     336        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    330337        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    331338      ENDIF 
    332339 
    333       CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib ) 
     340      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
    334341 
    335342      CALL iom_get( numrir, 'nn_fsbc', zfice ) 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OFF_SRC/domain.F90

    r4990 r5382  
    116116      USE ioipsl 
    117117      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    118       NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     118      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     119         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    119120         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    120          &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler 
     121         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    121122      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
    122123         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            & 
    … …  
    159160         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
    160161         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     162         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
    161163         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
    162164         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
    … …  
    171173      ninist = nn_istate 
    172174      nstock = nn_stock 
     175      nstocklist = nn_stocklist 
    173176      nwrite = nn_write 
    174177 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r5215 r5382  
    18831883      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
    18841884 
    1885       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     1885      CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf ) 
    18861886 
    18871887   END SUBROUTINE crs_dom_sfc 
    … …  
    22752275      ENDDO 
    22762276      
    2277       CALL wrk_alloc( jpi_crs, jpj_crs, zmbk ) 
    2278  
    22792277      zmbk(:,:) = 0.0 
    22802278      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) ) 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r4292 r5382  
    245245      CALL iom_put( "mldr10_3", zrho10_3     )   ! MLD delta rho(10m) = 0.03 
    246246      CALL iom_put( "pycndep" , zpycn        )   ! MLD delta rho equi. delta T(10m) = 0.2 
    247       CALL iom_put( "BLT"     , ztm2 - zpycn )   ! Barrier Layer Thickness 
    248247      CALL iom_put( "tinv"    , ztinv        )   ! max. temp. inv. (t10 ref)  
    249248      CALL iom_put( "depti"   , zdepinv      )   ! depth of max. temp. inv. (t10 ref)  

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r4990 r5382  
    135135      !!---------------------------------------------------------------------- 
    136136      USE ioipsl 
    137       NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     137      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     138         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    138139         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    139          &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler 
     140         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    140141      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    141142         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
    … …  
    169170         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
    170171         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in 
     172         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir 
    171173         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out 
     174         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir 
    172175         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
    173176         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler 
    … …  
    178181         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
    179182         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
    180          WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     183         IF( ln_rst_list ) THEN 
     184            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist 
     185         ELSE 
     186            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     187         ENDIF 
    181188         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
    182189         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
    183190         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     191         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
    184192         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
    185193         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
    … …  
    195203      ninist = nn_istate 
    196204      nstock = nn_stock 
     205      nstocklist = nn_stocklist 
    197206      nwrite = nn_write 
    198207      neuler = nn_euler 
    199       IF ( neuler == 1 .AND. .NOT.ln_rstart ) THEN 
     208      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    200209         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 
    201210         CALL ctl_warn( ctmp1 ) 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5120 r5382  
    472472         risfdep(:,:)=0.e0 
    473473         misfdep(:,:)=1 
    474          ! 
    475          ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code 
    476          IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN  
    477             risfdep(:,:)=200.e0  
    478             misfdep(:,:)=1  
    479             ij0 = 1 ; ij1 = 40  
    480             DO jj = mj0(ij0), mj1(ij1)  
    481                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp  
    482             END DO  
    483             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp  
    484          !  
    485          ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN 
    486          !  
    487             risfdep(:,:)=0.e0 
    488             misfdep(:,:)=1 
    489             ij0 = 1 ; ij1 = 40 
    490             DO jj = mj0(ij0), mj1(ij1) 
    491                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    492             END DO 
    493             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    494          END IF 
    495474         ! 
    496475         DEALLOCATE( idta, zdta ) 
    … …  
    969948      !! 
    970949      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    971       INTEGER  ::   ik, it          ! temporary integers 
     950      INTEGER  ::   ik, it, ikb, ikt ! temporary integers 
    972951      LOGICAL  ::   ll_print         ! Allow  control print for debugging 
    973952      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    … …  
    11521131      IF ( ln_isfcav ) THEN 
    11531132      ! (ISF) define e3uw (adapted for 2 cells in the water column) 
    1154       ! Need to test if the modification of only mikt and mbkt levels is enough 
    1155          DO jk = 2,jpk                           
    1156             DO jj = 1, jpjm1  
    1157                DO ji = 1, fs_jpim1   ! vector opt.  
    1158                   e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj  ,jk) ) & 
    1159                     &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj  ,jk-1) ) 
    1160                   e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji  ,jj+1,jk) ) & 
    1161                     &   - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji  ,jj+1,jk-1) ) 
    1162                END DO  
    1163             END DO  
     1133         DO jj = 2, jpjm1  
     1134            DO ji = 2, fs_jpim1   ! vector opt.  
     1135               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
     1136               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
     1137               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
     1138                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
     1139               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
     1140               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
     1141               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
     1142                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
     1143            END DO 
    11641144         END DO 
    11651145      END IF 
    1166        
     1146 
    11671147      CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
    11681148      CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    … …  
    15381518  
    15391519 ! remove single point "bay" on isf coast line in the ice shelf draft' 
    1540          DO jk = 1, jpk 
     1520         DO jk = 2, jpk 
    15411521            WHERE (misfdep==0) misfdep=jpk 
    15421522            zmask=0 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5163 r5382  
    110110         ELSEIF( cp_cfg == 'gyre' ) THEN          
    111111            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    112         ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN 
    113             IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain'  
    114             tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:)          ! ISOMIP configuration : start from constant T+S fields  
    115             tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:) 
    116             tsb(:,:,:,:)=tsn(:,:,:,:)   
    117112         ELSE                                    ! Initial T-S, U-V fields read in files 
    118113            IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r5120 r5382  
    55   !!============================================================================== 
    66   !! History :  1.0  !  2006-11  (G. Madec)  Original code 
    7    !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
     8   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
    89   !!---------------------------------------------------------------------- 
    910 
    … …  
    1718   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine) 
    1819   USE dynzad          ! vertical advection               (dyn_zad      routine) 
     20   ! 
    1921   USE in_out_manager  ! I/O manager 
    2022   USE lib_mpp         ! MPP library 
    … …  
    2527 
    2628   PUBLIC dyn_adv       ! routine called by step module 
    27    PUBLIC dyn_adv_init  ! routine called by opa module 
     29   PUBLIC dyn_adv_init  ! routine called by opa  module 
    2830  
     31   !                                    !* namdyn_adv namelist * 
    2932   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag 
     33   INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth 
    3034   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag 
    3135   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag 
    … …  
    3842#  include "vectopt_loop_substitute.h90" 
    3943   !!---------------------------------------------------------------------- 
    40    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    4145   !! $Id$ 
    4246   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6367      SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend 
    6468      CASE ( 0 )      
    65                       CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy 
    66                       CALL dyn_zad     ( kt )    ! vector form : vertical advection 
     69                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     70                      CALL dyn_zad     ( kt )               ! vector form : vertical advection 
    6771      CASE ( 1 )      
    68                       CALL dyn_keg     ( kt )    ! vector form : horizontal gradient of kinetic energy 
    69                       CALL dyn_zad_zts ( kt )    ! vector form : vertical advection with sub-timestepping 
     72                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     73                      CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping 
    7074      CASE ( 2 )  
    71                       CALL dyn_adv_cen2( kt )    ! 2nd order centered scheme 
     75                      CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
    7276      CASE ( 3 )    
    73                       CALL dyn_adv_ubs ( kt )    ! 3rd order UBS      scheme 
     77                      CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme 
    7478      ! 
    75       CASE (-1 )                                 ! esopa: test all possibility with control print 
    76                       CALL dyn_keg     ( kt ) 
     79      CASE (-1 )                                            ! esopa: test all possibility with control print 
     80                      CALL dyn_keg     ( kt, nn_dynkeg ) 
    7781                      CALL dyn_zad     ( kt ) 
    7882                      CALL dyn_adv_cen2( kt ) 
    … …  
    9296      !!              momentum advection formulation & scheme and set nadv 
    9397      !!---------------------------------------------------------------------- 
    94       INTEGER ::   ioptio 
    95       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    96       !! 
    97       NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
     98      INTEGER ::   ioptio, ios   ! Local integer 
     99      ! 
     100      NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 
    98101      !!---------------------------------------------------------------------- 
    99  
     102      ! 
    100103      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    101104      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    … …  
    112115         WRITE(numout,*) '~~~~~~~~~~~' 
    113116         WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    114          WRITE(numout,*) '          Vector/flux form (T/F)             ln_dynadv_vec  = ', ln_dynadv_vec 
    115          WRITE(numout,*) '          2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2 
    116          WRITE(numout,*) '          3rd order UBS advection scheme     ln_dynadv_ubs  = ', ln_dynadv_ubs 
    117          WRITE(numout,*) '      Sub timestepping of vertical advection ln_dynzad_zts  = ', ln_dynzad_zts 
     117         WRITE(numout,*) '          Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec 
     118         WRITE(numout,*) '          = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg 
     119         WRITE(numout,*) '          2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2 
     120         WRITE(numout,*) '          3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs 
     121         WRITE(numout,*) '          Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts 
    118122      ENDIF 
    119123 
    … …  
    126130      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 
    127131      IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   & 
    128           CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
    129       IF( ln_dynzad_zts .AND. ln_isfcav )   & 
    130           CALL ctl_stop( 'Sub timestepping of vertical advection does not work with ln_isfcav = .TRUE.' ) 
     132         CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 
     133      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   &   
     134         CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 
    131135 
    132136      !                               ! Set nadv 
    … …  
    139143      IF(lwp) THEN                    ! Print the choice 
    140144         WRITE(numout,*) 
    141          IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used' 
     145         IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used'  
    142146         IF( nadv ==  1 )   WRITE(numout,*) '         vector form : keg + zad_zts + vor is used' 
     147         IF( nadv ==  0 .OR. nadv ==  1 ) THEN 
     148            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) 'with Centered standard keg scheme' 
     149            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) 'with Hollingsworth keg scheme' 
     150         ENDIF 
    143151         IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used' 
    144152         IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used' 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r4990 r5382  
    44   !! Ocean dynamics:  kinetic energy gradient trend 
    55   !!====================================================================== 
    6    !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code 
    7    !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
    8    !!            9.0  !  02-07  (G. Madec)  F90: Free form and module 
     6   !! History :  1.0  !  1987-09  (P. Andrich, M.-A. Foujols)  Original code 
     7   !!            7.0  !  1997-05  (G. Madec)  Split dynber into dynkeg and dynhpg 
     8   !!  NEMO      1.0  !  2002-07  (G. Madec)  F90: Free form and module 
     9   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option  
    910   !!---------------------------------------------------------------------- 
    1011    
    … …  
    1819   ! 
    1920   USE in_out_manager  ! I/O manager 
     21   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2022   USE lib_mpp         ! MPP library 
    2123   USE prtctl          ! Print control 
    … …  
    2830   PUBLIC   dyn_keg    ! routine called by step module 
    2931    
     32   INTEGER, PARAMETER, PUBLIC  ::   nkeg_C2  = 0   !: 2nd order centered scheme (standard scheme) 
     33   INTEGER, PARAMETER, PUBLIC  ::   nkeg_HW  = 1   !: Hollingsworth et al., QJRMS, 1983 
     34   ! 
     35   REAL(wp) ::   r1_48 = 1._wp / 48._wp   !: =1/(4*2*6) 
     36    
    3037   !! * Substitutions 
    3138#  include "vectopt_loop_substitute.h90" 
    3239   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     40   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    3441   !! $Id$  
    3542   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3744CONTAINS 
    3845 
    39    SUBROUTINE dyn_keg( kt ) 
     46   SUBROUTINE dyn_keg( kt, kscheme ) 
    4047      !!---------------------------------------------------------------------- 
    4148      !!                  ***  ROUTINE dyn_keg  *** 
    … …  
    4552      !!      general momentum trend. 
    4653      !! 
    47       !! ** Method  :   Compute the now horizontal kinetic energy  
     54      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that  
     55      !!      conserve kinetic energy. Compute the now horizontal kinetic energy  
    4856      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 
     57      !!              * kscheme = nkeg_HW : Hollingsworth correction following 
     58      !!      Arakawa (2001). The now horizontal kinetic energy is given by: 
     59      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  ) 
     60      !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ] 
     61      !!       
    4962      !!      Take its horizontal gradient and add it to the general momentum 
    5063      !!      trend (ua,va). 
    … …  
    5467      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
    5568      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
     69      !! 
     70      !! ** References : Arakawa, A., International Geophysics 2001. 
     71      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    5672      !!---------------------------------------------------------------------- 
    57       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     73      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
     74      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    5875      ! 
    5976      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    6380      !!---------------------------------------------------------------------- 
    6481      ! 
    65       IF( nn_timing == 1 )  CALL timing_start('dyn_keg') 
     82      IF( nn_timing == 1 )   CALL timing_start('dyn_keg') 
    6683      ! 
    67       CALL wrk_alloc( jpi, jpj, jpk, zhke ) 
     84      CALL wrk_alloc( jpi,jpj,jpk,  zhke ) 
    6885      ! 
    6986      IF( kt == nit000 ) THEN 
    7087         IF(lwp) WRITE(numout,*) 
    71          IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend' 
     88         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme 
    7289         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7390      ENDIF 
    7491 
    7592      IF( l_trddyn ) THEN           ! Save ua and va trends 
    76          CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     93         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    7794         ztrdu(:,:,:) = ua(:,:,:)  
    7895         ztrdv(:,:,:) = va(:,:,:)  
    7996      ENDIF 
    8097       
    81       !                                                ! =============== 
    82       DO jk = 1, jpkm1                                 ! Horizontal slab 
    83          !                                             ! =============== 
    84          DO jj = 2, jpj         ! Horizontal kinetic energy at T-point 
    85             DO ji = fs_2, jpi   ! vector opt. 
    86                zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    87                   &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  ) 
    88                zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    89                   &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  ) 
    90                zhke(ji,jj,jk) = zv + zu 
    91 !!gm simplier coding  ==>>   ~ faster 
    92 !    don't forget to suppress local zu zv scalars 
    93 !               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    94 !                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    95 !                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    96 !                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) 
    97 !!gm end <<== 
    98             END DO   
    99          END DO   
    100          DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
     98      zhke(:,:,jpk) = 0._wp 
     99       
     100      SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==! 
     101      ! 
     102      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
     103         DO jk = 1, jpkm1 
     104            DO jj = 2, jpj 
     105               DO ji = fs_2, jpi   ! vector opt. 
     106                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     107                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
     108                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     109                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
     110                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
     111               END DO   
     112            END DO 
     113         END DO 
     114         ! 
     115      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
     116         DO jk = 1, jpkm1 
     117            DO jj = 2, jpjm1        
     118               DO ji = fs_2, jpim1   ! vector opt. 
     119                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
     120                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
     121                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
     122                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
     123                     ! 
     124                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
     125                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
     126                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
     127                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
     128                  zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
     129               END DO   
     130            END DO 
     131         END DO 
     132         CALL lbc_lnk( zhke, 'T', 1. ) 
     133         ! 
     134      END SELECT 
     135      ! 
     136      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
     137         DO jj = 2, jpjm1 
    101138            DO ji = fs_2, fs_jpim1   ! vector opt. 
    102139               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    … …  
    104141            END DO  
    105142         END DO 
    106 !!gm idea to be tested  ==>>   is it faster on scalar computers ? 
    107 !         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
    108 !            DO ji = fs_2, fs_jpim1   ! vector opt. 
    109 !               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   & 
    110 !                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   & 
    111 !                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   & 
    112 !                  ! 
    113 !                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    114 !                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    115 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj) 
    116 !                  ! 
    117 !               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   & 
    118 !                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   & 
    119 !                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   & 
    120 !                  ! 
    121 !                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    122 !                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    123 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj) 
    124 !            END DO  
    125 !         END DO 
    126 !!gm en idea            <<== 
    127          !                                             ! =============== 
    128       END DO                                           !   End of slab 
    129       !                                                ! =============== 
    130  
    131       IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic 
     143      END DO 
     144      ! 
     145      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    132146         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    133147         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    134148         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    135          CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     149         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    136150      ENDIF 
    137151      ! 
    … …  
    139153         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    140154      ! 
    141       CALL wrk_dealloc( jpi, jpj, jpk, zhke ) 
     155      CALL wrk_dealloc( jpi,jpj,jpk,  zhke ) 
    142156      ! 
    143       IF( nn_timing == 1 )  CALL timing_stop('dyn_keg') 
     157      IF( nn_timing == 1 )   CALL timing_stop('dyn_keg') 
    144158      ! 
    145159   END SUBROUTINE dyn_keg 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r5215 r5382  
    6464                                                                                            ! start and count arrays 
    6565      LOGICAL                      ::   ll_found_restart 
     66      CHARACTER(len=256)           ::   cl_path 
    6667      CHARACTER(len=256)           ::   cl_filename 
    6768      CHARACTER(len=NF90_MAX_NAME) ::   cl_dname 
    … …  
    7071      !!---------------------------------------------------------------------- 
    7172 
    72       ! Find a restart file 
     73      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts.  
     74      cl_path = TRIM(cn_ocerst_indir) 
     75      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    7376      cl_filename = ' ' 
    7477      IF ( lk_mpp ) THEN 
    7578         cl_filename = ' ' 
    7679         WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1 
    77          INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart ) 
     80         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    7881      ELSE 
    7982         cl_filename = 'restart_icebergs.nc' 
    80          INQUIRE( file=TRIM(cl_filename), exist=ll_found_restart ) 
     83         INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    8184      ENDIF 
    8285 
    … …  
    8689 
    8790      IF (nn_verbose_level >= 0 .AND. lwp)  & 
    88          WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_filename) 
    89  
    90       nret = NF90_OPEN(TRIM(cl_filename), NF90_NOWRITE, ncid) 
     91         WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename) 
     92 
     93      nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid) 
    9194      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed') 
    9295 
    … …  
    228231      INTEGER ::   jn   ! dummy loop index 
    229232      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
     233      CHARACTER(len=256)     :: cl_path 
    230234      CHARACTER(len=256)     :: cl_filename 
    231235      TYPE(iceberg), POINTER :: this 
    … …  
    233237      !!---------------------------------------------------------------------- 
    234238 
     239      ! Assume we write iceberg restarts to same directory as ocean restarts. 
     240      cl_path = TRIM(cn_ocerst_outdir) 
     241      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    235242      IF( lk_mpp ) THEN 
    236          WRITE(cl_filename,'("icebergs_",I8.8,"_restart_",I4.4,".nc")') kt, narea-1 
     243         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 
    237244      ELSE 
    238          WRITE(cl_filename,'("icebergs_",I8.8,"_restart.nc")') kt 
    239       ENDIF 
    240       IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_filename) 
    241  
    242       nret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ncid) 
     245         WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 
     246      ENDIF 
     247      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) 
     248 
     249      nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid) 
    243250      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed') 
    244251 
    … …  
    372379         ENDIF 
    373380      ENDDO 
    374       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_ice  written' 
     381      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice  written' 
    375382 
    376383      nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) ) 
    … …  
    379386      nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 
    380387      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed') 
    381       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: stored_heat written' 
     388      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written' 
    382389 
    383390      nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) ) 
    … …  
    385392      nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) ) 
    386393      IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed') 
    387       IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_filename),' var: calving written' 
     394      IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written' 
    388395 
    389396      IF ( ASSOCIATED(first_berg) ) THEN 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5220 r5382  
    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   !!---------------------------------------------------------------------- 
    … …  
    8591   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    8692   INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
     93   INTEGER ::   nrst_lst              !: number of restart to output next 
    8794 
    8895   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5299 r5382  
    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 
    … …  
    139139      ENDIF 
    140140 
     141      IF ( ln_cfmeta ) THEN   ! add cell bounds 
     142         CALL set_grid_bounds( "T", cdname )  
     143         CALL set_grid_bounds( "U", cdname ) 
     144         CALL set_grid_bounds( "V", cdname ) 
     145         CALL set_grid_bounds( "W", cdname ) 
     146      ENDIF 
    141147 
    142148      ! vertical grid definition 
    … …  
    152158#endif 
    153159      CALL iom_set_axis_attr( "icbcla", class_num ) 
     160      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
     161      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 
    154162       
    155163      ! automatic definitions of some of the xml attributs 
    … …  
    11071115 
    11081116   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    1109       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 
    1110       CHARACTER(LEN=*)                 , INTENT(in) ::   cdid 
    1111       INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1112       INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1113       INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
    1114       REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1115       LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask 
     1117      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
     1118      &                                    nvertex, bounds_lon, bounds_lat ) 
     1119      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1120      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1121      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1122      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
     1123      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1124      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat 
     1125      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    11161126 
    11171127      IF ( xios_is_valid_domain     (cdid) ) THEN 
    … …  
    11191129            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    11201130            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1121             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1131            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, bounds_lat=bounds_lat ) 
    11221132      ENDIF 
    11231133 
    … …  
    11261136            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    11271137            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1128             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1138            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, bounds_lat=bounds_lat ) 
    11291139      ENDIF 
    11301140      CALL xios_solve_inheritance() 
    … …  
    12511261       
    12521262   END SUBROUTINE set_grid 
     1263 
     1264 
     1265   SUBROUTINE set_grid_bounds( cdgrd, cdname ) 
     1266      !!---------------------------------------------------------------------- 
     1267      !!                   ***  ROUTINE set_grid_bounds  *** 
     1268      !! 
     1269      !! ** Purpose :   define horizontal grid corners 
     1270      !! 
     1271      !!---------------------------------------------------------------------- 
     1272      CHARACTER(LEN=1) , INTENT(in) :: cdgrd 
     1273      CHARACTER(LEN=*) , INTENT(in) :: cdname 
     1274      ! 
     1275      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
     1276      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)     :: z_cnr       ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 
     1277      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)     :: z_pnt       ! Lat/lon coordinates of the point of cell (i,j) 
     1278      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells 
     1279      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells 
     1280      ! 
     1281      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1282      !                                                          ! represents the bottom-left corner of cell (i,j) 
     1283      INTEGER :: ji, jj, jn, ni, nj 
     1284 
     1285      ALLOCATE( z_bnds(4,jpi,jpj,2), z_cnr(jpi,jpj,2), z_pnt(jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
     1286 
     1287      ! Grid information 
     1288      SELECT CASE ( TRIM(cdgrd) ) 
     1289         CASE ('T', 'W') 
     1290            icnr = -1 ; jcnr = -1 
     1291            IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1292               z_cnr(:,:,1) = gphif_crs ; z_cnr(:,:,2) = glamf_crs 
     1293               z_pnt(:,:,1) = gphit_crs ; z_pnt(:,:,2) = glamt_crs 
     1294            ELSE 
     1295               z_cnr(:,:,1) = gphif ; z_cnr(:,:,2) = glamf 
     1296               z_pnt(:,:,1) = gphit ; z_pnt(:,:,2) = glamt 
     1297            ENDIF 
     1298         CASE ('U') 
     1299            icnr =  0 ; jcnr = -1 
     1300            IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1301               z_cnr(:,:,1) = gphiv_crs ; z_cnr(:,:,2) = glamv_crs 
     1302               z_pnt(:,:,1) = gphiu_crs ; z_pnt(:,:,2) = glamu_crs 
     1303            ELSE 
     1304               z_cnr(:,:,1) = gphiv ; z_cnr(:,:,2) = glamv 
     1305               z_pnt(:,:,1) = gphiu ; z_pnt(:,:,2) = glamu 
     1306            ENDIF 
     1307         CASE ('V') 
     1308            icnr = -1 ; jcnr =  0 
     1309            IF( TRIM(cdname) == "nemo_crs" ) THEN 
     1310               z_cnr(:,:,1) = gphiu_crs ; z_cnr(:,:,2) = glamu_crs 
     1311               z_pnt(:,:,1) = gphiv_crs ; z_pnt(:,:,2) = glamv_crs 
     1312            ELSE 
     1313               z_cnr(:,:,1) = gphiu ; z_cnr(:,:,2) = glamu 
     1314               z_pnt(:,:,1) = gphiv ; z_pnt(:,:,2) = glamv 
     1315            ENDIF 
     1316      END SELECT 
     1317 
     1318      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
     1319 
     1320      z_fld(:,:) = 1._wp 
     1321      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     1322 
     1323      ! Cell vertices that can be defined 
     1324      DO jj = 2, jpjm1 
     1325         DO ji = 2, jpim1 
     1326            z_bnds(1,ji,jj,:) = z_cnr(ji+icnr,  jj+jcnr  ,:) ! Bottom-left 
     1327            z_bnds(2,ji,jj,:) = z_cnr(ji+icnr+1,jj+jcnr  ,:) ! Bottom-right 
     1328            z_bnds(3,ji,jj,:) = z_cnr(ji+icnr+1,jj+jcnr+1,:) ! Top-right 
     1329            z_bnds(4,ji,jj,:) = z_cnr(ji+icnr,  jj+jcnr+1,:) ! Top-left 
     1330         END DO 
     1331      END DO 
     1332 
     1333      ! Cell vertices on boundries 
     1334      DO jn = 1, 4 
     1335         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
     1336         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
     1337      END DO 
     1338 
     1339      ! Zero-size cells at closed boundaries 
     1340      IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1341         DO jn = 1, 4  ;  z_bnds(jn,1,:,:) = z_pnt(1,:,:)        ;  END DO      ! (West or jpni = 1), closed E-W 
     1342      ENDIF 
     1343      IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1344         DO jn = 1, 4  ;  z_bnds(jn,nlci,:,:) = z_pnt(nlci,:,:)  ;  END DO      ! (East or jpni = 1), closed E-W 
     1345      ENDIF 
     1346      IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
     1347         DO jn = 1, 4  ;  z_bnds(jn,:,1,:) = z_pnt(:,1,:)        ;  END DO      ! South or (jpnj = 1, not symmetric) 
     1348      ENDIF 
     1349      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
     1350         DO jn = 1, 4  ;  z_bnds(jn,:,nlcj,:) = z_pnt(:,nlcj,:)  ;  END DO      ! (North or jpnj = 1), no north fold 
     1351      ENDIF 
     1352 
     1353! ===================================================================================================== 
     1354!             Do we need to set zero-size cells at Mediterranean / Persian Gulf region? 
     1355! ===================================================================================================== 
     1356 
     1357      ! Rotate cells at the north fold 
     1358      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 
     1359         DO jj = 1, jpj 
     1360            DO ji = 1, jpi 
     1361               IF( z_fld(ji,jj) == -1. ) THEN 
     1362                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     1363                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     1364                  z_bnds(:,ji,jj,:) = z_rot(:,:) 
     1365               ENDIF 
     1366            END DO 
     1367         END DO 
     1368 
     1369      ! Invert cells at the symmetric equator 
     1370      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 
     1371         DO ji = 1, jpi 
     1372            z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
     1373            z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
     1374            z_bnds(:,ji,1,:) = z_rot(:,:) 
     1375         END DO 
     1376      ENDIF 
     1377 
     1378      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
     1379                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     1380 
     1381      DEALLOCATE( z_bnds, z_cnr, z_pnt, z_fld, z_rot )  
     1382 
     1383   END SUBROUTINE set_grid_bounds 
    12531384 
    12541385 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r4689 r5382  
    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/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5381 r5382  
    5656      !! 
    5757      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    58       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 
    5960      !!---------------------------------------------------------------------- 
    6061      ! 
    6162      IF( kt == nit000 ) THEN   ! default definitions 
    6263         lrst_oce = .FALSE.    
    63          nitrst = nitend 
    64       ENDIF 
    65       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    
    6674         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    6775         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    7280      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    7381      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    74          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    75          IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    76          ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
    77          ENDIF 
    78          ! create the file 
    79          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 
    80          IF(lwp) THEN 
    81             WRITE(numout,*) 
    82             SELECT CASE ( jprstlib ) 
    83             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname 
    84             CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname 
    85             END SELECT 
    86             IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
    87             IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
    88             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 
    8986            ENDIF 
    90          ENDIF 
    91          ! 
    92          CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
    93          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 
    94108      ENDIF 
    95109      ! 
    … …  
    136150!!gm  not sure what to do here   ===>>>  ask to Sebastian 
    137151         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. 
    138157      ENDIF 
    139158      ! 
    … …  
    150169      !!                the file has already been opened 
    151170      !!---------------------------------------------------------------------- 
    152       INTEGER  ::   jlibalt = jprstlib 
    153       LOGICAL  ::   llok 
     171      INTEGER        ::   jlibalt = jprstlib 
     172      LOGICAL        ::   llok 
     173      CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file 
    154174      !!---------------------------------------------------------------------- 
    155175      ! 
    … …  
    165185         ENDIF 
    166186 
     187         clpath = TRIM(cn_ocerst_indir) 
     188         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    167189         IF ( jprstlib == jprstdimg ) THEN 
    168190           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    169191           ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 
    170            INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
     192           INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 
    171193           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    172194         ENDIF 
    173          CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt ) 
     195         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 
    174196      ENDIF 
    175197   END SUBROUTINE rst_read_open 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5381 r5382  
    14401440      IF( srcv(jpr_cal)%laction ) THEN  
    14411441         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1442          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
     1442         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    14431443      ENDIF 
    14441444 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5362 r5382  
    382382      !!------------------------------------------------------------------- 
    383383      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    384       NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_out,   & 
     384      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    385385         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
    386386      !!------------------------------------------------------------------- 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5215 r5382  
    561561      CALL iom_put('isfgammat', zgammat2d) 
    562562      CALL iom_put('isfgammas', zgammas2d) 
    563          ! 
    564       !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf  ) 
     563      ! 
    565564      CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d ) 
    566565      ! 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5343 r5382  
    4747   USE lbclnk         ! ocean lateral boundary conditions 
    4848   USE timing          ! Timing 
     49   USE stopar          ! Stochastic T/S fluctuations 
     50   USE stopts          ! Stochastic T/S fluctuations 
    4951 
    5052   IMPLICIT NONE 
    … …  
    313315      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    314316      ! 
    315       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    316       REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
    317       REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
     317      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     318      INTEGER  ::   jdof 
     319      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     320      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     321      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
    318322      !!---------------------------------------------------------------------- 
    319323      ! 
    … …  
    324328      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    325329         ! 
    326          DO jk = 1, jpkm1 
    327             DO jj = 1, jpj 
    328                DO ji = 1, jpi 
    329                   ! 
    330                   zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    331                   zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    332                   zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    333                   ztm = tmask(ji,jj,jk)                                         ! tmask 
    334                   ! 
    335                   zn3 = EOS013*zt   & 
    336                      &   + EOS103*zs+EOS003 
    337                      ! 
    338                   zn2 = (EOS022*zt   & 
    339                      &   + EOS112*zs+EOS012)*zt   & 
    340                      &   + (EOS202*zs+EOS102)*zs+EOS002 
    341                      ! 
    342                   zn1 = (((EOS041*zt   & 
    343                      &   + EOS131*zs+EOS031)*zt   & 
    344                      &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    345                      &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    346                      &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    347                      ! 
    348                   zn0 = (((((EOS060*zt   & 
    349                      &   + EOS150*zs+EOS050)*zt   & 
    350                      &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    351                      &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    352                      &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    353                      &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    354                      &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    355                      ! 
    356                   zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    357                   ! 
    358                   prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    359                   ! 
    360                   prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     330         ! Stochastic equation of state 
     331         IF ( ln_sto_eos ) THEN 
     332            ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
     333            ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
     334            ALLOCATE(zsign(1:2*nn_sto_eos)) 
     335            DO jsmp = 1, 2*nn_sto_eos, 2 
     336              zsign(jsmp)   = 1._wp 
     337              zsign(jsmp+1) = -1._wp 
     338            END DO 
     339            ! 
     340            DO jk = 1, jpkm1 
     341               DO jj = 1, jpj 
     342                  DO ji = 1, jpi 
     343                     ! 
     344                     ! compute density (2*nn_sto_eos) times: 
     345                     ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
     346                     ! (2) for t-dt, s-ds (with the opposite fluctuation) 
     347                     DO jsmp = 1, nn_sto_eos*2 
     348                        jdof   = (jsmp + 1) / 2 
     349                        zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     350                        zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
     351                        zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
     352                        zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
     353                        ztm    = tmask(ji,jj,jk)                                         ! tmask 
     354                        ! 
     355                        zn3 = EOS013*zt   & 
     356                           &   + EOS103*zs+EOS003 
     357                           ! 
     358                        zn2 = (EOS022*zt   & 
     359                           &   + EOS112*zs+EOS012)*zt   & 
     360                           &   + (EOS202*zs+EOS102)*zs+EOS002 
     361                           ! 
     362                        zn1 = (((EOS041*zt   & 
     363                           &   + EOS131*zs+EOS031)*zt   & 
     364                           &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     365                           &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     366                           &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     367                           ! 
     368                        zn0_sto(jsmp) = (((((EOS060*zt   & 
     369                           &   + EOS150*zs+EOS050)*zt   & 
     370                           &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     371                           &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     372                           &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     373                           &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     374                           &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     375                           ! 
     376                        zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
     377                     END DO 
     378                     ! 
     379                     ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
     380                     prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
     381                     DO jsmp = 1, nn_sto_eos*2 
     382                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
     383                        ! 
     384                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked) 
     385                     END DO 
     386                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
     387                     prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
     388                  END DO 
    361389               END DO 
    362390            END DO 
    363          END DO 
    364          ! 
     391            DEALLOCATE(zn0_sto,zn_sto,zsign) 
     392         ! Non-stochastic equation of state 
     393         ELSE 
     394            DO jk = 1, jpkm1 
     395               DO jj = 1, jpj 
     396                  DO ji = 1, jpi 
     397                     ! 
     398                     zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
     399                     zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
     400                     zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     401                     ztm = tmask(ji,jj,jk)                                         ! tmask 
     402                     ! 
     403                     zn3 = EOS013*zt   & 
     404                        &   + EOS103*zs+EOS003 
     405                        ! 
     406                     zn2 = (EOS022*zt   & 
     407                        &   + EOS112*zs+EOS012)*zt   & 
     408                        &   + (EOS202*zs+EOS102)*zs+EOS002 
     409                        ! 
     410                     zn1 = (((EOS041*zt   & 
     411                        &   + EOS131*zs+EOS031)*zt   & 
     412                        &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
     413                        &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
     414                        &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
     415                        ! 
     416                     zn0 = (((((EOS060*zt   & 
     417                        &   + EOS150*zs+EOS050)*zt   & 
     418                        &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     419                        &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     420                        &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     421                        &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     422                        &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     423                        ! 
     424                     zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
     425                     ! 
     426                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
     427                     ! 
     428                     prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     429                  END DO 
     430               END DO 
     431            END DO 
     432         ENDIF 
     433          
    365434      CASE( 1 )                !==  simplified EOS  ==! 
    366435         ! 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90

    r5215 r5382  
    2727   !!--------------------------------------------------------------------------------- 
    2828   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    29    !! $Id$  
     29   !! $Id$ 
    3030   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3131   !!--------------------------------------------------------------------------------- 
    … …  
    4343      INTEGER ::   jk                 ! loop indice 
    4444      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    45       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     45      CHARACTER(LEN=50)   ::   clname   ! output restart file name 
     46      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    4647      !!-------------------------------------------------------------------------------- 
    4748 
    … …  
    5657         ! create the file 
    5758         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out) 
     59         clpath = TRIM(cn_ocerst_outdir) 
     60         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    5861         IF(lwp) THEN 
    5962            WRITE(numout,*) 
    … …  
    6770         ENDIF 
    6871 
    69          CALL iom_open( clname, nummxlw, ldwrt = .TRUE., kiolib = jprstlib ) 
     72         CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib ) 
    7073      ENDIF 
    7174 
    … …  
    133136      INTEGER ::   jlibalt = jprstlib 
    134137      LOGICAL ::   llok 
     138      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    135139      !!----------------------------------------------------------------------------- 
    136140 
    … …  
    140144         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~' 
    141145      ENDIF 
     146 
     147      clpath = TRIM(cn_ocerst_indir) 
     148      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     149 
    142150      IF ( jprstlib == jprstdimg ) THEN 
    143151         ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    144152         ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90 
    145          INQUIRE( FILE = TRIM(cn_trdrst_in)//'.nc', EXIST = llok ) 
     153         INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok ) 
    146154         IF ( llok ) THEN   ;   jlibalt = jpnf90    
    147155         ELSE               ;   jlibalt = jprstlib    
    … …  
    149157      ENDIF 
    150158 
    151       CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt )  
     159      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt )  
    152160 
    153161      IF( ln_trdmxl_instant ) THEN  

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r5120 r5382  
    171171            END DO 
    172172         END DO 
     173         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
     174 
    173175         IF ( ln_isfcav ) THEN 
    174176            DO jj = 2, jpjm1 
    175177               DO ji = 2, jpim1 
    176178                  ! (ISF) ======================================================================== 
    177                   ikbu = miku(ji,jj)         ! ocean bottom level at u- and v-points  
    178                   ikbv = mikv(ji,jj)         ! (deepest ocean u- and v-points) 
     179                  ikbu = miku(ji,jj)         ! ocean top level at u- and v-points  
     180                  ikbv = mikv(ji,jj)         ! (1st wet ocean u- and v-points) 
    179181                  ! 
    180182                  zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     & 
    … …  
    183185                     &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  ) 
    184186              ! 
    185                   zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 ) 
    186                   zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 
     187                  zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 ) 
     188                  zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 ) 
    187189              ! 
    188190                  tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj  ) ) * zecu * (1._wp - umask(ji,jj,1)) 
    … …  
    202204               END DO 
    203205            END DO 
    204          END IF 
    205          ! 
    206          CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition 
     206            CALL lbc_lnk( tfrua, 'U', 1. )   ;   CALL lbc_lnk( tfrva, 'V', 1. )      ! Lateral boundary condition 
     207         END IF 
     208         ! 
    207209         ! 
    208210         IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        & 
    … …  
    277279            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
    278280         ENDIF 
    279          IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_bfri1 
    280          IF( ln_tfr2d ) THEN 
    281             IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
    282             IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
    283          ENDIF 
     281         IF ( ln_isfcav ) THEN 
     282            IF(lwp) WRITE(numout,*) '      top    friction coef.   rn_bfri1  = ', rn_tfri1 
     283            IF( ln_tfr2d ) THEN 
     284               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     285               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
     286            ENDIF 
     287         END IF 
    284288         ! 
    285289         IF(ln_bfr2d) THEN 
    … …  
    295299         bfrua(:,:) = - bfrcoef2d(:,:) 
    296300         bfrva(:,:) = - bfrcoef2d(:,:) 
     301         ! 
     302         IF ( ln_isfcav ) THEN 
     303            IF(ln_tfr2d) THEN 
     304               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
     305               CALL iom_open('tfr_coef.nc',inum) 
     306               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
     307               CALL iom_close(inum) 
     308               tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     309            ELSE 
     310               tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
     311            ENDIF 
     312            ! 
     313            tfrua(:,:) = - tfrcoef2d(:,:) 
     314            tfrva(:,:) = - tfrcoef2d(:,:) 
     315         END IF 
    297316         ! 
    298317      CASE( 2 ) 
    … …  
    311330            IF(lwp) WRITE(numout,*) '      coef rn_bfri2 enhancement factor                rn_bfrien  = ',rn_bfrien 
    312331         ENDIF 
    313          IF(lwp) WRITE(numout,*) '      quadratic top    friction' 
    314          IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_tfri2 
    315          IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max 
    316          IF(lwp) WRITE(numout,*) '      background tke   rn_tfeb2  = ', rn_tfeb2 
    317          IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d = ', ln_loglayer 
    318          IF(lwp) WRITE(numout,*) '      bottom roughness  rn_tfrz0 [m] = ', rn_tfrz0 
    319          IF( rn_tfrz0<=0.e0 ) THEN 
    320             WRITE(ctmp1,*) '      bottom roughness must be strictly positive' 
    321             CALL ctl_stop( ctmp1 ) 
    322          ENDIF 
    323          IF( ln_tfr2d ) THEN 
    324             IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
    325             IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
    326          ENDIF 
     332         IF ( ln_isfcav ) THEN 
     333            IF(lwp) WRITE(numout,*) '      quadratic top    friction' 
     334            IF(lwp) WRITE(numout,*) '      friction coef.    rn_tfri2     = ', rn_tfri2 
     335            IF(lwp) WRITE(numout,*) '      Max. coef. (log case)   rn_tfri2_max  = ', rn_tfri2_max 
     336            IF(lwp) WRITE(numout,*) '      background tke    rn_tfeb2     = ', rn_tfeb2 
     337            IF(lwp) WRITE(numout,*) '      log formulation   ln_tfr2d     = ', ln_loglayer 
     338            IF(lwp) WRITE(numout,*) '      top roughness     rn_tfrz0 [m] = ', rn_tfrz0 
     339            IF( rn_tfrz0<=0.e0 ) THEN 
     340               WRITE(ctmp1,*) '      top roughness must be strictly positive' 
     341               CALL ctl_stop( ctmp1 ) 
     342            ENDIF 
     343            IF( ln_tfr2d ) THEN 
     344               IF(lwp) WRITE(numout,*) '      read coef. enhancement distribution from file   ln_tfr2d  = ', ln_tfr2d 
     345               IF(lwp) WRITE(numout,*) '      coef rn_tfri2 enhancement factor                rn_tfrien  = ',rn_tfrien 
     346            ENDIF 
     347         END IF 
    327348         ! 
    328349         IF(ln_bfr2d) THEN 
    … …  
    336357            bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
    337358         ENDIF 
     359          
     360         IF ( ln_isfcav ) THEN 
     361            IF(ln_tfr2d) THEN 
     362               ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 
     363               CALL iom_open('tfr_coef.nc',inum) 
     364               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
     365               CALL iom_close(inum) 
     366               ! 
     367               tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     368            ELSE 
     369               tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
     370            ENDIF 
     371         END IF 
    338372         ! 
    339373         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    … …  
    346380               END DO 
    347381            END DO 
     382            IF ( ln_isfcav ) THEN 
     383               DO jj = 1, jpj 
     384                  DO ji = 1, jpi 
     385                     ikbt = mikt(ji,jj) 
     386                     ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 
     387                     tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 
     388                     tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) 
     389                  END DO 
     390               END DO 
     391            END IF 
    348392         ENDIF 
    349393         ! 
    … …  
    398442             zminbfr = MIN(  zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) )  ) 
    399443             zmaxbfr = MAX(  zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) )  ) 
     444! (ISF) 
     445             IF ( ln_isfcav ) THEN 
     446                ikbu = miku(ji,jj)       ! 1st wet ocean level at u- and v-points 
     447                ikbv = mikv(ji,jj) 
     448                zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 
     449                zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 
     450                IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 
     451                   IF( ln_ctl ) THEN 
     452                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu 
     453                      WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru 
     454                   ENDIF 
     455                   ictu = ictu + 1 
     456                ENDIF 
     457                IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN 
     458                   IF( ln_ctl ) THEN 
     459                      WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv 
     460                      WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv 
     461                   ENDIF 
     462                   ictv = ictv + 1 
     463                ENDIF 
     464                zmintfr = MIN(  zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) )  ) 
     465                zmaxtfr = MAX(  zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) )  ) 
     466             END IF 
     467! END ISF 
    400468         END DO 
    401469      END DO 
    … …  
    405473         CALL mpp_min( zminbfr ) 
    406474         CALL mpp_max( zmaxbfr ) 
     475         IF ( ln_isfcav) CALL mpp_min( zmintfr ) 
     476         IF ( ln_isfcav) CALL mpp_max( zmaxtfr ) 
    407477      ENDIF 
    408478      IF( .NOT.ln_bfrimp) THEN 
    409479      IF( lwp .AND. ictu + ictv > 0 ) THEN 
    410          WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points ' 
    411          WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points ' 
     480         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points ' 
     481         WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points ' 
    412482         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr 
    413          WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 
    414          WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary' 
     483         IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 
     484         WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary' 
    415485      ENDIF 
    416486      ENDIF 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5376 r5382  
    8383   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8484   USE sbc_oce, ONLY: lk_oasis 
     85   USE stopar 
     86   USE stopts 
    8587 
    8688   IMPLICIT NONE 
    … …  
    437439      IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 )   CALL cla_init       ! Cross Land Advection 
    438440                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     441                            CALL sto_par_init   ! Stochastic parametrization 
     442      IF( ln_sto_eos     )  CALL sto_pts_init   ! RRandom T/S fluctuations 
    439443      
    440444#if defined key_top 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5220 r5382  
    107107 
    108108      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     109      ! Update stochastic parameters and random T/S fluctuations 
     110      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     111                        CALL sto_par( kstp )          ! Stochastic parameters 
     112 
     113      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    109114      ! Ocean physics update                (ua, va, tsa used as workspace) 
    110115      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    146151      ! 
    147152      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
     153         IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations 
    148154                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
    149155         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    181187          ! Note that the computation of vertical velocity above, hence "after" sea level 
    182188          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
     189            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    183190                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    184191            IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    262269         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    263270                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     271            IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
    264272                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    265273            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    … …  
    272280      ELSE                                                  ! centered hpg  (eos then time stepping) 
    273281         IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
     282            IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
    274283                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
    275284         IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4990 r5382  
    5353 
    5454   USE dynnxt           ! time-stepping                    (dyn_nxt routine) 
     55 
     56   USE stopar           ! Stochastic parametrization       (sto_par routine) 
     57   USE stopts  
    5558 
    5659   USE bdy_par          ! for lk_bdy 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    r5215 r5382  
    3939      ! 
    4040      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    41       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     41      CHARACTER(LEN=50)   ::   clname   ! output restart file name 
     42      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    4243      CHARACTER (len=35) :: charout 
    4344      INTEGER :: jl,  jk, jn               ! loop indice 
    … …  
    5152         ENDIF 
    5253         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out) 
    53          IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname 
    54          CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
     54         clpath = TRIM(cn_trcrst_outdir) 
     55         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     56         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname) 
     57         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
    5558      ENDIF 
    5659 
    … …  
    133136      INTEGER ::  jlibalt = jprstlib 
    134137      LOGICAL ::  llok 
     138      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    135139      !!----------------------------------------------------------------------------- 
    136140       
    … …  
    141145      ENDIF 
    142146       
     147      clpath = TRIM(cn_trcrst_indir) 
     148      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     149 
    143150      IF ( jprstlib == jprstdimg ) THEN 
    144151        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    145152        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90 
    146         INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
     153        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
    147154        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    148155      ENDIF 
    149156 
    150       CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt )  
     157      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt )  
    151158       
    152159      IF( ln_trdmxl_trc_instant ) THEN  

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r4990 r5382  
    5454   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
    5555   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     56   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory 
    5657   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     58   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    5759   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
    5860   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
    … …  
    172174   !!---------------------------------------------------------------------- 
    173175   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    174    !! $Id$  
     176   !! $Id$ 
    175177   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    176178   !!---------------------------------------------------------------------- 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r4990 r5382  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     41   !! $Id$ 
    4242   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    … …  
    175175      !!--------------------------------------------------------------------- 
    176176      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    177         &                  cn_trcrst_in, cn_trcrst_out 
     177        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
     178 
    178179 
    179180      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    … …  
    339340   !!---------------------------------------------------------------------- 
    340341   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    341    !! $Id$  
     342   !! $Id$ 
    342343   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    343344   !!====================================================================== 

  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r4990 r5382  
    5151      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5252      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
     53      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
    5354      !!---------------------------------------------------------------------- 
    5455      ! 
    … …  
    5657         IF( kt == nittrc000 ) THEN 
    5758            lrst_trc = .FALSE. 
    58             nitrst = nitend 
    59          ENDIF 
    60  
    61          IF( MOD( kt - 1, nstock ) == 0 ) THEN 
     59            IF( ln_rst_list ) THEN 
     60               nrst_lst = 1 
     61               nitrst = nstocklist( nrst_lst ) 
     62            ELSE 
     63               nitrst = nitend 
     64            ENDIF 
     65         ENDIF 
     66 
     67         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
    6268            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    6369            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    7985         IF(lwp) WRITE(numout,*) 
    8086         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out) 
    81          IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname 
    82          CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
     87         clpath = TRIM(cn_trcrst_outdir) 
     88         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     89         IF(lwp) WRITE(numout,*) & 
     90             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname 
     91         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
    8392         lrst_trc = .TRUE. 
    8493      ENDIF 
    … …  
    140149          lrst_trc = .FALSE. 
    141150#endif 
     151          IF( lk_offline .AND. ln_rst_list ) THEN 
     152             nrst_lst = nrst_lst + 1 
     153             nitrst = nstocklist( nrst_lst ) 
     154          ENDIF 
    142155      ENDIF 
    143156      ! 
    … …  
    190203           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    191204           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    192            INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
     205           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    193206           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    194207         ENDIF 
    195208 
    196          CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     209         CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    197210 
    198211         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    … …  
    306319   !!---------------------------------------------------------------------- 
    307320   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    308    !! $Id$  
     321   !! $Id$ 
    309322   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    310323   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.