ecearth3/sources/nemo-3.6/NEMO/LIM_SRC_3/limwri_dimg.h90

SUBROUTINE lim_wri
   !!----------------------------------------------------------------------
   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
   !! $Id: limwri_dimg.h90 4688 2014-06-24 23:39:59Z clem $
   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
   !!-------------------------------------------------------------------
   !!  This routine computes the average of some variables and write it
   !!  on the ouput files.
   !!  ATTENTION cette routine n'est valable que si le pas de temps est
   !!  egale a une fraction entiere de 1 jours.
   !!  Diff 1-D 3-D : suppress common also included in etat
   !!                 suppress cmoymo 11-18
   !!  modif : 03/06/98
   !!-------------------------------------------------------------------
   USE  diawri, ONLY : dia_wri_dimg
   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)

   REAL(wp),DIMENSION(1) ::   zdept

   REAL(wp) ::   zsto, zsec, zjulian,zout, &
   REAL(wp) ::   zindh,zinda,zindb, ztmu
   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
   REAL(wp), DIMENSION(jpi,jpj) ::   zfield
   INTEGER, SAVE ::   nmoyice   !: counter for averaging
   INTEGER, SAVE ::   nwf       !: number of fields to write on disk
   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
   ! according to namelist

   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
#if ! defined key_diainstant
   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable 
#else
   LOGICAL, PARAMETER :: ll_dia_inst=.true.
#endif
   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
   INTEGER :: iyear, iday, imon ! 

   CHARACTER(LEN=80) :: clname, cltext, clmode


   INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
   INTEGER , DIMENSION( jpij ) , SAVE ::   ndex51  
   !!-------------------------------------------------------------------
   IF ( numit == nstart ) THEN 

      CALL lim_wri_init 

      nwf = 0 
      ii  = 0

      IF (lwp ) THEN
         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
         WRITE(numout,*) '~~~~~~~~'
         WRITE(numout,*) '   According to namelist_ice, following fields saved:'
         DO jf =1, noumef
            IF (nc(jf) == 1 ) THEN
               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
            ENDIF
         END DO
      ENDIF

      DO jf = 1, noumef
         IF (nc(jf) == 1 ) nwf = nwf + 1
      END DO

      ALLOCATE( nsubindex (nwf) )

      DO jf = 1, noumef
         IF (nc(jf) == 1 ) THEN 
            ii = ii +1 
            nsubindex(ii) = jf
         END IF
      END DO

      zsto     = rdt_ice
      zout     = nwrite * rdt_ice / nn_fsbc
      zsec     = 0.
      niter    = 0
      zdept(1) = 0.
      nmoyice  = 0

   ENDIF

#if ! defined key_diainstant 
   !-- calculs des valeurs instantanees

   zcmo(:,:, 1:jpnoumax ) = 0.e0 
   DO jj = 2 , jpjm1
      DO ji = 2 , jpim1   ! NO vector opt.
         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
         zindb  = zindh * zinda
         ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) ) 
         zcmo(ji,jj,1)  = ht_s (ji,jj,1)
         zcmo(ji,jj,2)  = ht_i (ji,jj,1)
         zcmo(ji,jj,3)  = 0.
         zcmo(ji,jj,4)  = frld  (ji,jj)
         zcmo(ji,jj,5)  = sist  (ji,jj)
         zcmo(ji,jj,6)  = fhtur  (ji,jj)
         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
            / ztmu 

         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
            / ztmu
         zcmo(ji,jj,9)  = sst_m(ji,jj)
         zcmo(ji,jj,10) = sss_m(ji,jj)

         zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
         zcmo(ji,jj,12) = qsr(ji,jj)
         zcmo(ji,jj,13) = qns(ji,jj)
         ! See thersf for the coefficient
         zcmo(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in Kg/m2/day = mm/day
         zcmo(ji,jj,15) = utau_ice(ji,jj)
         zcmo(ji,jj,16) = vtau_ice(ji,jj)
         zcmo(ji,jj,17) = qsr (ji,jj)
         zcmo(ji,jj,18) = qns(ji,jj)
         zcmo(ji,jj,19) = sprecip(ji,jj)
      END DO
   END DO
   ! Cumulates values between outputs           
   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
   nmoyice = nmoyice + 1 
   ! compute mean value if it is time to write on file
   IF ( MOD(numit,nwrite) == 0 ) THEN
      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
#else  
      IF ( MOD(numit,nwrite) == 0 ) THEN 
         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
         DO jj = 2 , jpjm1
            DO ji = 2 , jpim1   ! NO vector opt.
               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
               zindb  = zindh * zinda
               ztmu   = MAX( 0.5 * 1._wp , ( umask(ji,jj,1) + umask(ji+1,jj,1) + umask(ji,jj+1,1) + umask(ji+1,jj+1,1) ) )
               rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
               rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
               rcmoy(ji,jj,3)  = 0.
               rcmoy(ji,jj,4)  = frld  (ji,jj)
               rcmoy(ji,jj,5)  = sist  (ji,jj)
               rcmoy(ji,jj,6)  = fhtur  (ji,jj)
               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                  / ztmu

               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
                  / ztmu
               rcmoy(ji,jj,9)  = sst_m(ji,jj)
               rcmoy(ji,jj,10) = sss_m(ji,jj)

               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
               rcmoy(ji,jj,12) = qsr(ji,jj)
               rcmoy(ji,jj,13) = qns(ji,jj)
               ! See thersf for the coefficient
               rcmoy(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in mm/day
               rcmoy(ji,jj,15) = utau_ice(ji,jj)
               rcmoy(ji,jj,16) = vtau_ice(ji,jj)
               rcmoy(ji,jj,17) = qsr(ji,jj)
               rcmoy(ji,jj,18) = qns(ji,jj)
               rcmoy(ji,jj,19) = sprecip(ji,jj)
            END DO
         END DO
#endif

         !
         niter = niter + 1
         DO jf = 1 , noumef
            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)

            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
               CALL lbc_lnk( zfield, 'T', -1. )
            ELSE 
               CALL lbc_lnk( zfield, 'T',  1. )
            ENDIF
            rcmoy(:,:,jf) = zfield(:,:)
         END DO

         IF (ll_dia_inst) THEN
            clmode='instantaneous'
         ELSE
            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
         END IF
         iyear = ndastp/10000
         imon = (ndastp-iyear*10000)/100
         iday = ndastp - imon*100 - iyear*10000
         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
9000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")

         rcmoy(:,:,:) = 0.0
         nmoyice = 0 
      END IF     !  MOD(numit, nwrite == 0 ) !

   END SUBROUTINE lim_wri