Ticket #908: limwri_dimg_2.h90

File limwri_dimg_2.h90, 8.9 KB (added by molines, 9 years ago)
Line 
1    SUBROUTINE lim_wri_2(kt)
2   !!----------------------------------------------------------------------
3   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
4   !! $Id: limwri_dimg_2.h90 3200 2011-12-07 15:00:49Z cbricaud $
5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6   !!----------------------------------------------------------------------
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    !!-------------------------------------------------------------------
16    USE  diadimg                ! use of dia_wri_dimg
17
18    INTEGER, INTENT(in) ::   kt     ! number of iteration
19
20    INTEGER , SAVE ::   nmoyice   !: counter for averaging
21    INTEGER , SAVE ::   nwf       !: number of fields to write on disk
22    INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
23    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
24    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy
25
26    INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
27    INTEGER :: iyear, iday, imon !
28    INTEGER :: ialloc
29    CHARACTER(LEN=80) :: clname, cltext, clmode
30    REAL(wp), DIMENSION(1) ::   zdept
31    REAL(wp) ::   zsto, zsec, zjulian,zout
32    REAL(wp) ::   zindh, zinda, zindb, ztmu
33    REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
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    !!-------------------------------------------------------------------
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
47
48    CALL wrk_alloc( jpi, jpj, zfield )
49
50    IF ( kt == nit000 ) THEN
51       !
52       CALL lim_wri_init_2
53
54       nwf = 0
55       ii  = 0
56
57       IF (lwp ) THEN
58          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg'
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
81       rcmoy(:,:,:) = 0.0_wp
82       zsto     = rdt_ice
83       zout     = nwrite * rdt_ice / nn_fsbc
84       zsec     = 0.
85       niter    = 0
86       zdept(1) = 0.
87       nmoyice  = 0
88
89    ENDIF
90
91#if ! defined key_diainstant
92    !-- Compute mean values
93
94    zcmo(:,:, 1:jpnoumax ) = 0.e0
95    DO jj = 2 , jpjm1
96       DO ji = 2 , jpim1
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)
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  )   &
109             &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
110               / ztmu
111
112            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
113             &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
114               / ztmu
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
120          zcmo(ji,jj,9)  = sst_m(ji,jj)
121          zcmo(ji,jj,10) = sss_m(ji,jj)
122
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)
126          ! See thersf for the coefficient
127          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
128          zcmo(ji,jj,15) = utau_ice(ji,jj)
129          zcmo(ji,jj,16) = vtau_ice(ji,jj)
130          zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
131          zcmo(ji,jj,18) = qns_ice(ji,jj,1)
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
139    IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
140       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
141#else 
142       IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
143          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
144          DO jj = 2 , jpjm1
145             DO ji = 2 , jpim1
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)
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
160
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
168                rcmoy(ji,jj,9)  = sst_m(ji,jj)
169                rcmoy(ji,jj,10) = sss_m(ji,jj)
170
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)
174                ! See thersf for the coefficient
175                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
176                rcmoy(ji,jj,15) = utau_ice(ji,jj)
177                rcmoy(ji,jj,16) = vtau_ice(ji,jj)
178                rcmoy(ji,jj,17) = qsr_ice(ji,jj,1)
179                rcmoy(ji,jj,18) = qns_ice(ji,jj,1)
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
190             SELECT CASE (jf)
191             CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors)
192                CALL lbc_lnk( zfield, 'T', -1. )
193             CASE DEFAULT          ! scalar fields
194                CALL lbc_lnk( zfield, 'T',  1. )
195             END SELECT
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
214       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) !
215       CALL wrk_dealloc( jpi,jpj, zfield )
216
217     END SUBROUTINE lim_wri_2