source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 @ 5443

Last change on this file since 5443 was 5443, checked in by davestorkey, 5 years ago

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

File size: 7.7 KB
Line 
1SUBROUTINE lim_wri
2   !!----------------------------------------------------------------------
3   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
4   !! $Id$
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  diawri, ONLY : dia_wri_dimg
17   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
18
19   REAL(wp),DIMENSION(1) ::   zdept
20
21   REAL(wp) ::   zsto, zsec, zjulian,zout, &
22   REAL(wp) ::   zindh,zinda,zindb, ztmu
23   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
24   REAL(wp), DIMENSION(jpi,jpj) ::   zfield
25   INTEGER, SAVE ::   nmoyice   !: counter for averaging
26   INTEGER, SAVE ::   nwf       !: number of fields to write on disk
27   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
28   ! according to namelist
29
30   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
31#if ! defined key_diainstant
32   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable
33#else
34   LOGICAL, PARAMETER :: ll_dia_inst=.true.
35#endif
36   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
37   INTEGER :: iyear, iday, imon !
38
39   CHARACTER(LEN=80) :: clname, cltext, clmode
40
41
42   INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
43   INTEGER , DIMENSION( jpij ) , SAVE ::   ndex51 
44   !!-------------------------------------------------------------------
45   IF ( numit == nstart ) THEN
46
47      CALL lim_wri_init
48
49      nwf = 0
50      ii  = 0
51
52      IF (lwp ) THEN
53         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
54         WRITE(numout,*) '~~~~~~~~'
55         WRITE(numout,*) '   According to namelist_ice, following fields saved:'
56         DO jf =1, noumef
57            IF (nc(jf) == 1 ) THEN
58               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
59            ENDIF
60         END DO
61      ENDIF
62
63      DO jf = 1, noumef
64         IF (nc(jf) == 1 ) nwf = nwf + 1
65      END DO
66
67      ALLOCATE( nsubindex (nwf) )
68
69      DO jf = 1, noumef
70         IF (nc(jf) == 1 ) THEN
71            ii = ii +1
72            nsubindex(ii) = jf
73         END IF
74      END DO
75
76      zsto     = rdt_ice
77      zout     = nwrite * rdt_ice / nn_fsbc
78      zsec     = 0.
79      niter    = 0
80      zdept(1) = 0.
81      nmoyice  = 0
82
83   ENDIF
84
85#if ! defined key_diainstant
86   !-- calculs des valeurs instantanees
87
88   zcmo(:,:, 1:jpnoumax ) = 0.e0
89   DO jj = 2 , jpjm1
90      DO ji = 2 , jpim1   ! NO vector opt.
91         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
92         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
93         zindb  = zindh * zinda
94         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) ) )
95         zcmo(ji,jj,1)  = ht_s (ji,jj,1)
96         zcmo(ji,jj,2)  = ht_i (ji,jj,1)
97         zcmo(ji,jj,3)  = 0.
98         zcmo(ji,jj,4)  = frld  (ji,jj)
99         zcmo(ji,jj,5)  = sist  (ji,jj)
100         zcmo(ji,jj,6)  = fhtur  (ji,jj)
101         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
102            + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
103            / ztmu
104
105         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
106            + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
107            / ztmu
108         zcmo(ji,jj,9)  = sst_m(ji,jj)
109         zcmo(ji,jj,10) = sss_m(ji,jj)
110
111         zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
112         zcmo(ji,jj,12) = qsr(ji,jj)
113         zcmo(ji,jj,13) = qns(ji,jj)
114         ! See thersf for the coefficient
115         zcmo(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in Kg/m2/day = mm/day
116         zcmo(ji,jj,15) = utau_ice(ji,jj)
117         zcmo(ji,jj,16) = vtau_ice(ji,jj)
118         zcmo(ji,jj,17) = qsr (ji,jj)
119         zcmo(ji,jj,18) = qns(ji,jj)
120         zcmo(ji,jj,19) = sprecip(ji,jj)
121      END DO
122   END DO
123   ! Cumulates values between outputs           
124   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
125   nmoyice = nmoyice + 1
126   ! compute mean value if it is time to write on file
127   IF ( MOD(numit,nwrite) == 0 ) THEN
128      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
129#else 
130      IF ( MOD(numit,nwrite) == 0 ) THEN
131         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
132         DO jj = 2 , jpjm1
133            DO ji = 2 , jpim1   ! NO vector opt.
134               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )
135               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
136               zindb  = zindh * zinda
137               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) ) )
138               rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
139               rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
140               rcmoy(ji,jj,3)  = 0.
141               rcmoy(ji,jj,4)  = frld  (ji,jj)
142               rcmoy(ji,jj,5)  = sist  (ji,jj)
143               rcmoy(ji,jj,6)  = fhtur  (ji,jj)
144               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * umask(ji,jj,1) + u_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
145                  + u_ice(ji,jj+1) * umask(ji,jj+1,1) + u_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
146                  / ztmu
147
148               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * umask(ji,jj,1) + v_ice(ji+1,jj  ) * umask(ji+1,jj,1)   &
149                  + v_ice(ji,jj+1) * umask(ji,jj+1,1) + v_ice(ji+1,jj+1) * umask(ji+1,jj+1,1) ) &
150                  / ztmu
151               rcmoy(ji,jj,9)  = sst_m(ji,jj)
152               rcmoy(ji,jj,10) = sss_m(ji,jj)
153
154               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
155               rcmoy(ji,jj,12) = qsr(ji,jj)
156               rcmoy(ji,jj,13) = qns(ji,jj)
157               ! See thersf for the coefficient
158               rcmoy(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in mm/day
159               rcmoy(ji,jj,15) = utau_ice(ji,jj)
160               rcmoy(ji,jj,16) = vtau_ice(ji,jj)
161               rcmoy(ji,jj,17) = qsr(ji,jj)
162               rcmoy(ji,jj,18) = qns(ji,jj)
163               rcmoy(ji,jj,19) = sprecip(ji,jj)
164            END DO
165         END DO
166#endif
167
168         !
169         niter = niter + 1
170         DO jf = 1 , noumef
171            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
172
173            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
174               CALL lbc_lnk( zfield, 'T', -1. )
175            ELSE
176               CALL lbc_lnk( zfield, 'T',  1. )
177            ENDIF
178            rcmoy(:,:,jf) = zfield(:,:)
179         END DO
180
181         IF (ll_dia_inst) THEN
182            clmode='instantaneous'
183         ELSE
184            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
185         END IF
186         iyear = ndastp/10000
187         imon = (ndastp-iyear*10000)/100
188         iday = ndastp - imon*100 - iyear*10000
189         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
190         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
191         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
1929000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
193
194         rcmoy(:,:,:) = 0.0
195         nmoyice = 0
196      END IF     !  MOD(numit, nwrite == 0 ) !
197
198   END SUBROUTINE lim_wri
Note: See TracBrowser for help on using the repository browser.