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.
limwri_dimg_2.h90 in trunk/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90 @ 3564

Last change on this file since 3564 was 3564, checked in by rblod, 11 years ago

fix output average with EVP, see ticket #908

  • Property svn:keywords set to Id
File size: 8.8 KB
RevLine 
[821]1    SUBROUTINE lim_wri_2(kt)
[247]2   !!----------------------------------------------------------------------
[2528]3   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
[1156]4   !! $Id$
[2528]5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[247]6   !!----------------------------------------------------------------------
[107]7    !!-------------------------------------------------------------------
8    !!  This routine computes the average of some variables and write it
9    !!  on the ouput files.
10    !!  ATTENTION cette routine n'est valable que si le pas de temps est
11    !!  egale a une fraction entiere de 1 jours.
12    !!  Diff 1-D 3-D : suppress common also included in etat
13    !!                 suppress cmoymo 11-18
14    !!  modif : 03/06/98
15    !!-------------------------------------------------------------------
[3564]16    USE  diadimg                ! use of dia_wri_dimg
[508]17
18    INTEGER, INTENT(in) ::   kt     ! number of iteration
19
[2715]20    INTEGER , SAVE ::   nmoyice   !: counter for averaging
21    INTEGER , SAVE ::   nwf       !: number of fields to write on disk
[3564]22    INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
[2715]23    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
[3294]24    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy
[107]25
[2715]26    INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
27    INTEGER :: iyear, iday, imon !
[3294]28    INTEGER :: ialloc
[2715]29    CHARACTER(LEN=80) :: clname, cltext, clmode
30    REAL(wp), DIMENSION(1) ::   zdept
31    REAL(wp) ::   zsto, zsec, zjulian,zout
[3564]32    REAL(wp) ::   zindh, zinda, zindb, ztmu
33    REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
[107]34
35#if ! defined key_diainstant
36    LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable
37#else
38    LOGICAL, PARAMETER :: ll_dia_inst=.true.
39#endif
40    !!-------------------------------------------------------------------
[3294]41    IF( .NOT. ALLOCATED(rcmoy) )THEN
42        ALLOCATE(rcmoy(jpi,jpj,jpnoumax),  STAT=ialloc )
43       !
44       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
45       IF( ialloc /= 0 )   CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays')
46    ENDIF
[107]47
[3564]48    CALL wrk_alloc( jpi, jpj, zfield )
49
50    IF ( kt == nit000 ) THEN
[2715]51       !
[821]52       CALL lim_wri_init_2
[107]53
54       nwf = 0
55       ii  = 0
56
[3564]57       IF (lwp ) THEN
[821]58          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg'
[107]59          WRITE(numout,*) '~~~~~~~~'
60          WRITE(numout,*) '   According to namelist_ice, following fields saved:'
61          DO jf =1, noumef
62             IF (nc(jf) == 1 ) THEN
63                WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
64             ENDIF
65          END DO
66       ENDIF
67
68       DO jf = 1, noumef
69          IF (nc(jf) == 1 ) nwf = nwf + 1
70       END DO
71
72       ALLOCATE( nsubindex (nwf) )
73
74       DO jf = 1, noumef
75          IF (nc(jf) == 1 ) THEN
76             ii = ii +1
77             nsubindex(ii) = jf
78          END IF
79       END DO
80
[3564]81       rcmoy(:,:,:) = 0.0_wp
[107]82       zsto     = rdt_ice
[888]83       zout     = nwrite * rdt_ice / nn_fsbc
[107]84       zsec     = 0.
85       niter    = 0
86       zdept(1) = 0.
87       nmoyice  = 0
88
89    ENDIF
90
91#if ! defined key_diainstant
[3564]92    !-- Compute mean values
[107]93
94    zcmo(:,:, 1:jpnoumax ) = 0.e0
95    DO jj = 2 , jpjm1
[3564]96       DO ji = 2 , jpim1
[107]97          zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
98          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
99          zindb  = zindh * zinda
100          zcmo(ji,jj,1)  = hsnif (ji,jj)
101          zcmo(ji,jj,2)  = hicif (ji,jj)
102          zcmo(ji,jj,3)  = hicifp(ji,jj)
103          zcmo(ji,jj,4)  = frld  (ji,jj)
104          zcmo(ji,jj,5)  = sist  (ji,jj)
105          zcmo(ji,jj,6)  = fbif  (ji,jj)
[3564]106          IF (lk_lim2_vp) THEN
107            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
108            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
[1470]109             &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[107]110               / ztmu
111
[3564]112            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
[1470]113             &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[107]114               / ztmu
[3564]115           ELSE
116            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0
117            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0
118           ENDIF
119
[888]120          zcmo(ji,jj,9)  = sst_m(ji,jj)
121          zcmo(ji,jj,10) = sss_m(ji,jj)
[107]122
[888]123          zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
124          zcmo(ji,jj,12) = qsr(ji,jj)
125          zcmo(ji,jj,13) = qns(ji,jj)
[107]126          ! See thersf for the coefficient
[888]127          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
[1469]128          zcmo(ji,jj,15) = utau_ice(ji,jj)
129          zcmo(ji,jj,16) = vtau_ice(ji,jj)
[1463]130          zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
131          zcmo(ji,jj,18) = qns_ice(ji,jj,1)
[107]132          zcmo(ji,jj,19) = sprecip(ji,jj)
133       END DO
134    END DO
135    ! Cumulates values between outputs           
136    rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
137    nmoyice = nmoyice + 1
138    ! compute mean value if it is time to write on file
[888]139    IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
[107]140       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
141#else 
[888]142       IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
[107]143          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
144          DO jj = 2 , jpjm1
[3564]145             DO ji = 2 , jpim1
[107]146                zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
147                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
148                zindb  = zindh * zinda
149                rcmoy(ji,jj,1)  = hsnif (ji,jj)
150                rcmoy(ji,jj,2)  = hicif (ji,jj)
151                rcmoy(ji,jj,3)  = hicifp(ji,jj)
152                rcmoy(ji,jj,4)  = frld  (ji,jj)
153                rcmoy(ji,jj,5)  = sist  (ji,jj)
154                rcmoy(ji,jj,6)  = fbif  (ji,jj)
[3564]155                IF (lk_lim2_vp) THEN
156                   ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
157                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
158                      &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
159                        / ztmu
[107]160
[3564]161                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
162                      &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
163                       / ztmu
164                ELSE
165                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0
166                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0
167                ENDIF
[888]168                rcmoy(ji,jj,9)  = sst_m(ji,jj)
169                rcmoy(ji,jj,10) = sss_m(ji,jj)
[107]170
[888]171                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
172                rcmoy(ji,jj,12) = qsr(ji,jj)
173                rcmoy(ji,jj,13) = qns(ji,jj)
[107]174                ! See thersf for the coefficient
[888]175                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
[1469]176                rcmoy(ji,jj,15) = utau_ice(ji,jj)
177                rcmoy(ji,jj,16) = vtau_ice(ji,jj)
[1463]178                rcmoy(ji,jj,17) = qsr_ice(ji,jj,1)
179                rcmoy(ji,jj,18) = qns_ice(ji,jj,1)
[107]180                rcmoy(ji,jj,19) = sprecip(ji,jj)
181             END DO
182          END DO
183#endif
184
185          !
186          niter = niter + 1
187          DO jf = 1 , noumef
188             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
189
[3564]190             SELECT CASE (jf)
191             CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors)
[107]192                CALL lbc_lnk( zfield, 'T', -1. )
[3564]193             CASE DEFAULT          ! scalar fields
[107]194                CALL lbc_lnk( zfield, 'T',  1. )
[3564]195             END SELECT
[107]196             rcmoy(:,:,jf) = zfield(:,:)
197          END DO
198
199          IF (ll_dia_inst) THEN
200           clmode='instantaneous'
201          ELSE
202           WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
203          END IF
204          iyear = ndastp/10000
205          imon = (ndastp-iyear*10000)/100
206          iday = ndastp - imon*100 - iyear*10000
207          WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
208          cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
209          CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
2109000      FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
211
212          rcmoy(:,:,:) = 0.0
213          nmoyice = 0
[888]214       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) !
[3564]215       CALL wrk_dealloc( jpi,jpj, zfield )
[107]216
[821]217     END SUBROUTINE lim_wri_2
Note: See TracBrowser for help on using the repository browser.