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 @ 3558

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

Fix issues when using key_nosignedzeo, see ticket #996

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