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.h90 in branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90 @ 6917

Last change on this file since 6917 was 3963, checked in by clem, 11 years ago

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