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 10222 for NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90 – NEMO

Ignore:
Timestamp:
2018-10-25T11:42:23+02:00 (6 years ago)
Author:
aumont
Message:

update of the sediment module + enhancement, bug correction in PISCES generating O2 negative values

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90

    r6140 r10222  
    11MODULE sedrst 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!                       *** MODULE sedrst *** 
     
    1110   USE sed 
    1211   USE sedarr 
     12   USE trc_oce, ONLY: l_offline         ! ocean space and time domain variables 
     13   USE iom 
     14   USE daymod 
     15   USE lib_mpp         ! distribued memory computing library 
    1316 
    1417 
     
    1821 
    1922   !! * Accessibility 
     23   PUBLIC sed_rst_opn       ! called by ??? 
    2024   PUBLIC sed_rst_read 
    2125   PUBLIC sed_rst_wri 
    22  
    23    !! * Module variables 
    24    INTEGER, PUBLIC ::   numrsr, numrsw   !: logical unit for sed restart (read and write) 
    25     
    26     
     26   PUBLIC sed_rst_cal 
     27 
    2728   !! $Id$ 
    2829CONTAINS 
    2930 
     31 
     32   SUBROUTINE sed_rst_opn( kt ) 
     33      !!---------------------------------------------------------------------- 
     34      !!                    ***  sed_rst_opn  *** 
     35      !! 
     36      !! ** purpose  :   output of sed-trc variable in a netcdf file 
     37      !!---------------------------------------------------------------------- 
     38      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     39      ! 
     40      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
     41      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
     42      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
     43      !!---------------------------------------------------------------------- 
     44      ! 
     45      IF( l_offline ) THEN 
     46         IF( kt == nittrc000 ) THEN 
     47            lrst_sed = .FALSE. 
     48            IF( ln_rst_list ) THEN 
     49               nrst_lst = 1 
     50               nitrst = nstocklist( nrst_lst ) 
     51            ELSE 
     52               nitrst = nitend 
     53            ENDIF 
     54         ENDIF 
     55         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
     56            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
     57            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     58            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
     59         ENDIF 
     60      ELSE 
     61         IF( kt == nittrc000 ) lrst_sed = .FALSE. 
     62      ENDIF 
     63 
     64      ! to get better performances with NetCDF format: 
     65      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
     66      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
     67      IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 
     68         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
     69         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     70         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     71         ENDIF 
     72         ! create the file 
     73         IF(lwp) WRITE(numsed,*) 
     74         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out) 
     75         clpath = TRIM(cn_sedrst_outdir) 
     76         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     77         IF(lwp) WRITE(numsed,*) & 
     78             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname 
     79         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpksed ) 
     80         lrst_sed = .TRUE. 
     81      ENDIF 
     82      ! 
     83   END SUBROUTINE sed_rst_opn 
    3084 
    3185   SUBROUTINE sed_rst_read  
     
    4094      !!        !  06-07  (C. Ethe)  original 
    4195      !!---------------------------------------------------------------------- 
    42       !! * Modules used 
    43       USE iom 
    4496 
    4597      !! * local declarations 
    46       INTEGER :: ji, jk, jn  
    47       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zdta 
    48       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zdta1  
    49       REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zhipor 
     98      INTEGER :: ji, jj, jk, jn  
     99      REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta 
     100      REAL(wp), DIMENSION(jpi,jpj,jpksed,2)        :: zdta1  
     101      REAL(wp), DIMENSION(jpi,jpj,jpksed)          :: zdta2 
     102      REAL(wp), DIMENSION(jpoce,jpksed)            :: zhipor 
    50103      REAL(wp) :: zkt 
    51104      CHARACTER(len = 20) ::   cltra 
     105      CHARACTER(LEN=20)   ::   name1 
    52106      INTEGER             ::   jlibalt = jprstlib 
    53107      LOGICAL             ::   llok 
    54108      !-------------------------------------------------------------------- 
    55   
    56  
    57       WRITE(numsed,*) ' '       
    58       WRITE(numsed,*) ' Initilization of Sediment components from restart' 
    59       WRITE(numsed,*) ' ' 
    60  
    61       ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) )  
    62  
    63       CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )      
    64       CALL iom_get( numrsr, 'kt'     , zkt      )   ! time-step 
    65   
     109 
     110      IF( ln_timing )  CALL timing_start('sed_rst_read') 
     111 
     112      IF (lwp) WRITE(numsed,*) ' '       
     113      IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart' 
     114      IF (lwp) WRITE(numsed,*) ' ' 
     115 
     116      zdta  = 1. 
     117      zdta1 = 1. 
     118      zdta2 = 0. 
     119 
    66120      DO jn = 1, jptrased 
    67          cltra = sedtrcd(jn) 
    68          CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), & 
    69             &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 
    70       ENDDO 
    71          
    72  
    73       CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), & 
    74          &            zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) ) 
    75  
    76       CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), & 
    77          &             zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) 
    78  
    79       CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), & 
    80          &             zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) ) 
    81  
    82       CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), & 
    83          &             zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) ) 
    84  
    85       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), & 
    86          &             zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) ) 
    87  
    88  
    89       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), & 
    90          &             zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) ) 
    91  
    92  
    93       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), & 
    94          &             zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) ) 
    95  
    96       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), & 
    97          &             zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) ) 
    98  
    99       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), & 
    100          &             zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) ) 
    101  
    102       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), & 
    103          &             zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) ) 
    104  
    105       CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), & 
    106          &             zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) ) 
     121         cltra = TRIM(sedtrcd(jn)) 
     122         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
     123            CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 
     124         ELSE 
     125            zdta(:,:,:,jn) = 0.0 
     126         ENDIF 
     127      ENDDO 
     128 
     129      DO jn = 1, jpsol 
     130         CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), & 
     131         &              zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) ) 
     132      END DO 
     133 
     134      DO jn = 1, jpwat 
     135         CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), & 
     136         &              zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) ) 
     137      END DO 
    107138 
    108139      DO jn = 1, 2 
    109          cltra = seddia3d(jn) 
    110          CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), & 
    111             &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 
     140         cltra = TRIM(seddia3d(jn)) 
     141         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
     142            CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 
     143         ELSE 
     144            zdta1(:,:,:,jn) = 0.0 
     145         ENDIF 
    112146      ENDDO 
    113147 
     
    122156         ENDDO 
    123157      ENDDO 
    124        
     158 
    125159      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), & 
    126160         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) 
     
    131165      pwcp (1:jpoce,1,:) = 0. 
    132166 
    133       DEALLOCATE( zdta   ) 
    134       DEALLOCATE( zdta1  ) 
    135       DEALLOCATE( zhipor ) 
     167      cltra = "dbioturb" 
     168      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
     169         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     170      ELSE 
     171         zdta2(:,:,:) = 0.0 
     172      ENDIF 
     173 
     174      CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), & 
     175         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 
     176 
     177      cltra = "irrig" 
     178      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
     179         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     180      ELSE 
     181         zdta2(:,:,:) = 0.0 
     182      ENDIF 
     183 
     184      CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), & 
     185         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 
     186 
     187      cltra = "sedligand" 
     188      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
     189         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     190      ELSE 
     191         zdta2(:,:,:) = 0.0 
     192      ENDIF 
     193 
     194      CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), & 
     195         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 
     196 
     197      IF( ln_timing )  CALL timing_stop('sed_rst_read') 
    136198      
    137199   END SUBROUTINE sed_rst_read 
     
    147209      !!---------------------------------------------------------------------- 
    148210      !!* Modules used 
    149       USE ioipsl 
    150       !! *Arguments 
    151211      INTEGER, INTENT(in) ::   kt       ! number of iteration 
    152212      !! * local declarations 
    153       INTEGER  :: ji, jk 
    154       INTEGER  :: ic, jc, jn, itime  
    155       REAL(wp) :: zdate0 
     213      INTEGER  :: ji, jj, jk, jn 
    156214      REAL(wp), DIMENSION(1) ::  zinfo 
    157       CHARACTER(len=50) :: clname,cln 
    158       CHARACTER(len=20) :: cltra  
    159       REAL(wp), DIMENSION(:,:) , ALLOCATABLE  :: zdta    
     215      CHARACTER(len=50) :: clname 
     216      CHARACTER(len=20) :: cltra, name1  
     217      REAL(wp), DIMENSION(jpoce,jpksed)   :: zdta    
     218      REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 
    160219      !! ----------------------------------------------------------------------- 
    161220 
    162       ALLOCATE( zdta(jpoce,jpksed) ) 
    163  
    164       IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN 
    165           
     221      IF( ln_timing )  CALL timing_start('sed_rst_wri') 
     222 
    166223         !! 0. initialisations 
    167224         !! ------------------ 
    168225          
    169          IF(lwp) WRITE(numsed,*) ' ' 
    170          IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   & 
     226      IF(lwp) WRITE(numsed,*) ' ' 
     227      IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   & 
    171228            'at it= ',kt 
    172          IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 
     229      IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 
     230 
     231 
     232      trcsedi(:,:,:,:)   = 0.0 
     233      flxsedi3d(:,:,:,:) = 0.0 
     234      zdta(:,:)          = 1.0 
     235      zdta2(:,:,:)       = 0.0 
     236 
    173237          
    174          !! 1. WRITE in nutwrs 
    175          !! ------------------ 
    176  
    177          ic = 1 
    178          DO jc = 1,16 
    179             IF( cexper(jc:jc) /= ' ') ic = jc 
    180          END DO 
    181          WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday 
    182          clname = cexper(1:ic)//cln 
    183          itime = 0 
    184          CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 ) 
    185          zdate0 = zdate0 - adatrj   !   set calendar origin to the beginning of the experiment 
    186          CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, & 
    187             &         clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom ) 
    188          zinfo(1) = REAL( kt) 
    189          CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  ) 
    190  
    191  
    192  
    193          ! Back to 2D geometry 
    194          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 
    195             &                    solcp(1:jpoce,1:jpksed,jsopal ) ) 
     238      !! 1. WRITE in nutwrs 
     239      !! ------------------ 
     240 
     241      zinfo(1) = REAL( kt) 
     242      CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo  ) 
     243 
     244      ! Back to 2D geometry 
     245      DO jn = 1, jpsol 
     246         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 
     247         &                       solcp(1:jpoce,1:jpksed,jn ) ) 
     248      END DO 
     249 
     250      DO jn = 1, jpwat 
     251         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), & 
     252         &                       pwcp(1:jpoce,1:jpksed,jn  )  ) 
     253      END DO 
     254      ! pH 
     255      DO jk = 1, jpksed 
     256         DO ji = 1, jpoce 
     257            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 
     258         ENDDO 
     259      ENDDO 
     260 
     261      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), & 
     262      &                   zdta(1:jpoce,1:jpksed)  ) 
    196263          
    197          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 
    198             &                    solcp(1:jpoce,1:jpksed,jsclay ) ) 
    199           
    200          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 
    201             &                    solcp(1:jpoce,1:jpksed,jspoc  ) ) 
    202           
    203          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 
    204             &                    solcp(1:jpoce,1:jpksed,jscal  ) )    
    205           
    206          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 
    207             &                    pwcp(1:jpoce,1:jpksed,jwsil  )  ) 
    208           
    209          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), & 
    210             &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) ) 
    211           
    212          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), & 
    213             &                    pwcp(1:jpoce,1:jpksed,jwdic  ) ) 
    214           
    215          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), & 
    216             &                    pwcp(1:jpoce,1:jpksed,jwno3  ) ) 
    217           
    218          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), & 
    219             &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) ) 
    220           
    221          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), & 
    222             &                    pwcp(1:jpoce,1:jpksed,jwalk  ) ) 
    223           
    224          CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), & 
    225          &                    pwcp(1:jpoce,1:jpksed,jwc13  ) ) 
    226           
    227          ! porosity 
    228          zdta(:,:) = 0. 
    229          DO jk = 1, jpksed 
    230             DO ji = 1, jpoce 
    231                zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) 
    232             ENDDO 
    233          ENDDO 
    234          CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), & 
    235             &                   zdta(1:jpoce,1:jpksed)  ) 
    236           
    237          CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), & 
    238             &                   co3por(1:jpoce,1:jpksed)  ) 
    239        
    240          ! prognostic variables 
    241          ! -------------------- 
    242  
    243  
    244          DO jn = 1, jptrased 
    245             cltra = sedtrcd(jn) 
    246             CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) ) 
    247          ENDDO 
    248  
    249          DO jn = 1, 2 
    250             cltra = seddia3d(jn) 
    251             CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) ) 
    252          ENDDO 
    253  
    254  
    255          CALL restclo( numrsw ) 
    256  
    257       ENDIF 
    258  
    259       DEALLOCATE( zdta )   
     264      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), & 
     265      &                   co3por(1:jpoce,1:jpksed)  ) 
     266 
     267      ! prognostic variables 
     268      ! -------------------- 
     269 
     270      DO jn = 1, jptrased 
     271         cltra = TRIM(sedtrcd(jn)) 
     272         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) ) 
     273      ENDDO 
     274 
     275      DO jn = 1, 2 
     276         cltra = TRIM(seddia3d(jn)) 
     277         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) ) 
     278      ENDDO 
     279 
     280      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), & 
     281      &                   db(1:jpoce,1:jpksed)  ) 
     282 
     283      cltra = "dbioturb" 
     284      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 
     285 
     286      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), & 
     287      &                   irrig(1:jpoce,1:jpksed)  ) 
     288 
     289      cltra = "irrig" 
     290      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 
     291 
     292      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), & 
     293      &                   sedligand(1:jpoce,1:jpksed)  ) 
     294 
     295      cltra = "sedligand" 
     296      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 
     297 
     298      IF( kt == nitrst ) THEN 
     299          CALL iom_close( numrsw )     ! close the restart file (only at last time step) 
     300          IF( l_offline .AND. ln_rst_list ) THEN 
     301             nrst_lst = nrst_lst + 1 
     302             nitrst = nstocklist( nrst_lst ) 
     303          ENDIF 
     304      ENDIF 
     305 
     306      IF( ln_timing )  CALL timing_stop('sed_rst_wri') 
    260307          
    261308   END SUBROUTINE sed_rst_wri 
    262 #else 
    263    !!====================================================================== 
    264    !! MODULE sedrst :   Dummy module  
    265    !!====================================================================== 
    266    !! $Id$ 
    267 CONTAINS 
    268    SUBROUTINE sed_rst_read                      ! Empty routines 
    269    END SUBROUTINE sed_rst_read 
    270    SUBROUTINE sed_rst_wri( kt ) 
    271       INTEGER, INTENT ( in ) :: kt 
    272       WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt 
    273    END SUBROUTINE sed_rst_wri    
    274 #endif 
     309 
     310 
     311   SUBROUTINE sed_rst_cal( kt, cdrw ) 
     312      !!--------------------------------------------------------------------- 
     313      !!                   ***  ROUTINE sed_rst_cal  *** 
     314      !! 
     315      !!  ** Purpose : Read or write calendar in restart file: 
     316      !! 
     317      !!  WRITE(READ) mode: 
     318      !!       kt        : number of time step since the begining of the experiment at the 
     319      !!                   end of the current(previous) run 
     320      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the 
     321      !!                   end of the current(previous) run (REAL -> keep fractions of day) 
     322      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer) 
     323      !! 
     324      !!   According to namelist parameter nrstdt, 
     325      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary). 
     326      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last 
     327      !!                   time step of previous run + 1. 
     328      !!       In both those options, the  exact duration of the experiment 
     329      !!       since the beginning (cumulated duration of all previous restart runs) 
     330      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
     331      !!       This is valid is the time step has remained constant. 
     332      !! 
     333      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj) 
     334      !!                    has been stored in the restart file. 
     335      !!---------------------------------------------------------------------- 
     336      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     337      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     338      ! 
     339      INTEGER  ::  jlibalt = jprstlib 
     340      LOGICAL  ::  llok 
     341      REAL(wp) ::  zkt, zrdttrc1 
     342      REAL(wp) ::  zndastp 
     343 
     344      ! Time domain : restart 
     345      ! --------------------- 
     346 
     347      IF( TRIM(cdrw) == 'READ' ) THEN 
     348 
     349         IF(lwp) WRITE(numsed,*) 
     350         IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar' 
     351         IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~' 
     352 
     353         IF( ln_rst_sed ) THEN 
     354            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr, kiolib = jlibalt ) 
     355            CALL iom_get ( numrsr, 'kt', zkt )   ! last time-step of previous run 
     356 
     357            IF(lwp) THEN 
     358               WRITE(numsed,*) ' *** Info read in restart : ' 
     359               WRITE(numsed,*) '   previous time-step                               : ', NINT( zkt ) 
     360               WRITE(numsed,*) ' *** restart option' 
     361               SELECT CASE ( nn_rstsed ) 
     362               CASE ( 0 )   ;   WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000' 
     363               CASE ( 1 )   ;   WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
     364               CASE ( 2 )   ;   WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart' 
     365               END SELECT 
     366               WRITE(numsed,*) 
     367            ENDIF 
     368            ! Control of date  
     369            IF( nittrc000  - NINT( zkt ) /= nn_dtsed .AND.  nn_rstsed /= 0 )                                  & 
     370               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
     371               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     372         ENDIF 
     373         ! 
     374         IF( l_offline ) THEN 
     375            !                                          ! set the date in offline mode 
     376            IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN 
     377               CALL iom_get( numrsr, 'ndastp', zndastp ) 
     378               ndastp = NINT( zndastp ) 
     379               CALL iom_get( numrsr, 'adatrj', adatrj  ) 
     380             ELSE 
     381               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
     382               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 
     383               ! note this is wrong if time step has changed during run 
     384            ENDIF 
     385            ! 
     386            IF(lwp) THEN 
     387              WRITE(numsed,*) ' *** Info used values : ' 
     388              WRITE(numsed,*) '   date ndastp                                      : ', ndastp 
     389              WRITE(numsed,*) '   number of elapsed days since the begining of run : ', adatrj 
     390              WRITE(numsed,*) 
     391            ENDIF 
     392            ! 
     393            CALL day_init          ! compute calendar 
     394            ! 
     395         ENDIF 
     396         ! 
     397      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     398         ! 
     399         IF(  kt == nitrst ) THEN 
     400            IF(lwp) WRITE(numsed,*) 
     401            IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 
     402            IF(lwp) WRITE(numsed,*) '~~~~~~~' 
     403         ENDIF 
     404         CALL iom_rstput( kt, nitrst, numrsw, 'kt'     , REAL( kt    , wp) )   ! time-step 
     405         CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) )   ! date 
     406         CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj            )   ! number of elapsed days since 
     407         !                                                                     ! the begining of the run [s] 
     408      ENDIF 
     409 
     410   END SUBROUTINE sed_rst_cal 
    275411 
    276412END MODULE sedrst 
Note: See TracChangeset for help on using the changeset viewer.