ecearth3/sources/nemo-3.6/NEMO/TOP_SRC/PISCES/SED/sedrst.F90

MODULE sedrst
#if defined key_sed
   !!======================================================================
   !!                       *** MODULE sedrst ***
   !!   Read and write the restart files for sediment
   !!======================================================================

   !!----------------------------------------------------------------------
   !! * Modules used
   !! ==============
   USE sed
   USE sedarr


   !! * Accessibility
   IMPLICIT NONE
   PRIVATE

   !! * Accessibility
   PUBLIC sed_rst_read
   PUBLIC sed_rst_wri

   !! * Module variables
   INTEGER, PUBLIC ::   numrsr, numrsw   !: logical unit for sed restart (read and write)
   
   
   !! $Id: sedrst.F90 2355 2015-05-20 07:11:50Z ufla $
CONTAINS


   SUBROUTINE sed_rst_read 
      !!----------------------------------------------------------------------
      !!                   ***  ROUTINE sed_rst_read  ***
      !!
      !! ** Purpose :  Initialization of sediment module
      !!               - sets initial sediment composition
      !!                 ( only clay or reading restart file )
      !!
      !!   History :
      !!        !  06-07  (C. Ethe)  original
      !!----------------------------------------------------------------------
      !! * Modules used
      USE iom

      !! * local declarations
      INTEGER :: ji, jk, jn 
      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zdta
      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zdta1 
      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zhipor
      REAL(wp) :: zkt
      CHARACTER(len = 20) ::   cltra
      INTEGER             ::   jlibalt = jprstlib
      LOGICAL             ::   llok
      !--------------------------------------------------------------------
 

      WRITE(numsed,*) ' '      
      WRITE(numsed,*) ' Initilization of Sediment components from restart'
      WRITE(numsed,*) ' '

      ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 

      IF ( jprstlib == jprstdimg ) THEN
        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
        ! if restart_sed.nc exists, then set jlibalt to jpnf90
        INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )
        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
      ENDIF

      CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )     
      CALL iom_get( numrsr, 'kt'     , zkt      )   ! time-step
 
      DO jn = 1, jptrased
         cltra = sedtrcd(jn)
         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), &
            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
      ENDDO
        

      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), &
         &            zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), &
         &             zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), &
         &             zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), &
         &             zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), &
         &             zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) )


      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), &
         &             zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) )


      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), &
         &             zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), &
         &             zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), &
         &             zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), &
         &             zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) )

      CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), &
         &             zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) )

      DO jn = 1, 2
         cltra = seddia3d(jn)
         CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), &
            &          kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) )
      ENDDO

      zhipor(:,:) = 0.
      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )

      ! Initialization of [h+] in mol/kg
      DO jk = 1, jpksed
         DO ji = 1, jpoce
            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
         ENDDO
      ENDDO
      
      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )

      ! Initialization of sediment composant only ie jk=2 to jk=jpksed 
      ! ( nothing in jk=1)
      solcp(1:jpoce,1,:) = 0.
      pwcp (1:jpoce,1,:) = 0.

      DEALLOCATE( zdta   )
      DEALLOCATE( zdta1  )
      DEALLOCATE( zhipor )
     
   END SUBROUTINE sed_rst_read

   SUBROUTINE sed_rst_wri( kt )
      !!----------------------------------------------------------------------
      !!                   ***  ROUTINE sed_rst_wri  ***
      !!
      !! ** Purpose :  save field which are necessary for sediment restart
      !!
      !!   History :
      !!        !  06-07  (C. Ethe)  original
      !!----------------------------------------------------------------------
      !!* Modules used
      USE ioipsl
      !! *Arguments
      INTEGER, INTENT(in) ::   kt       ! number of iteration
      !! * local declarations
      INTEGER  :: ji, jk
      INTEGER  :: ic, jc, jn, itime 
      REAL(wp) :: zdate0
      REAL(wp), DIMENSION(1) ::  zinfo
      CHARACTER(len=50) :: clname,cln
      CHARACTER(len=20) :: cltra 
      REAL(wp), DIMENSION(:,:) , ALLOCATABLE  :: zdta   
      !! -----------------------------------------------------------------------

      ALLOCATE( zdta(jpoce,jpksed) )

      IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN
         
         !! 0. initialisations
         !! ------------------
         
         IF(lwp) WRITE(numsed,*) ' '
         IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
            'at it= ',kt
         IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
         
         !! 1. WRITE in nutwrs
         !! ------------------

         ic = 1
         DO jc = 1,16
            IF( cexper(jc:jc) /= ' ') ic = jc
         END DO
         WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday
         clname = cexper(1:ic)//cln
         itime = 0
         CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 )
         zdate0 = zdate0 - adatrj   !   set calendar origin to the beginning of the experiment
         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, &
            &         clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom )
         zinfo(1) = REAL( kt)
         CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo  )



         ! Back to 2D geometry
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
            &                    solcp(1:jpoce,1:jpksed,jsopal ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
            &                    solcp(1:jpoce,1:jpksed,jsclay ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), &
            &                    solcp(1:jpoce,1:jpksed,jspoc  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), &
            &                    solcp(1:jpoce,1:jpksed,jscal  ) )   
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwsil  )  )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwdic  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwno3  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), &
            &                    pwcp(1:jpoce,1:jpksed,jwalk  ) )
         
         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), &
         &                    pwcp(1:jpoce,1:jpksed,jwc13  ) )
         
         ! porosity
         zdta(:,:) = 0.
         DO jk = 1, jpksed
            DO ji = 1, jpoce
               zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) )
            ENDDO
         ENDDO
         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
            &                   zdta(1:jpoce,1:jpksed)  )
         
         CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
            &                   co3por(1:jpoce,1:jpksed)  )
      
         ! prognostic variables
         ! --------------------


         DO jn = 1, jptrased
            cltra = sedtrcd(jn)
            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) )
         ENDDO

         DO jn = 1, 2
            cltra = seddia3d(jn)
            CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) )
         ENDDO


         CALL restclo( numrsw )

      ENDIF

      DEALLOCATE( zdta )  
         
   END SUBROUTINE sed_rst_wri
#else
   !!======================================================================
   !! MODULE sedrst :   Dummy module 
   !!======================================================================
   !! $Id: sedrst.F90 2355 2015-05-20 07:11:50Z ufla $
CONTAINS
   SUBROUTINE sed_rst_read                      ! Empty routines
   END SUBROUTINE sed_rst_read
   SUBROUTINE sed_rst_wri( kt )
      INTEGER, INTENT ( in ) :: kt
      WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt
   END SUBROUTINE sed_rst_wri   
#endif

END MODULE sedrst