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_2.F90 in branches/dev_001_SBC/NEMO/LIM_SRC – NEMO

source: branches/dev_001_SBC/NEMO/LIM_SRC/limwri_2.F90 @ 882

Last change on this file since 882 was 882, checked in by ctlod, 16 years ago

dev_001_SBC: Step II: change effectively the modules names in addining _2 extension, see ticket: #110
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.6 KB
RevLine 
[881]1MODULE limwri_2
[3]2   !!======================================================================
[881]3   !!                     ***  MODULE  limwri_2  ***
[3]4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
[508]6   !! history :  2.0  ! 03-08  (C. Ethe) original code
7   !!            2.0  ! 04-10  (C. Ethe )  1D configuration
8   !!-------------------------------------------------------------------
[881]9#if defined key_lim2
[3]10   !!----------------------------------------------------------------------
[881]11   !!   'key_lim2'                                    LIM 2.0 sea-ice model
[3]12   !!----------------------------------------------------------------------
[508]13   !!----------------------------------------------------------------------
[881]14   !!   lim_wri_2      : write of the diagnostics variables in ouput file
15   !!   lim_wri_init_2 : initialization and namelist read
[3]16   !!----------------------------------------------------------------------
[717]17   USE phycst
[3]18   USE dom_oce
[717]19   USE daymod
[3]20   USE ice_oce         ! ice variables
[717]21   USE sbc_oce
22   USE sbc_ice
[881]23   USE dom_ice_2
24   USE ice_2
[717]25
26   USE lbclnk
27   USE dianam    ! build name of file (routine)
[709]28   USE in_out_manager
29   USE ioipsl
[3]30
31   IMPLICIT NONE
32   PRIVATE
33
[881]34   PUBLIC   lim_wri_2      ! routine called by sbc_ice_lim_2
[3]35
[508]36   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output
37   INTEGER                                  ::   noumef          ! number of fields
38   REAL(wp)           , DIMENSION(jpnoumax) ::   cmulti ,     &  ! multiplicative constant
39      &                                          cadd            ! additive constant
40   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn            ! title of the field
41   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam             ! name of the field
42   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni             ! unit of the field
43   INTEGER            , DIMENSION(jpnoumax) ::   nc              ! switch for saving field ( = 1 ) or not ( = 0 )
[3]44
[508]45   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ????
46   INTEGER , DIMENSION( jpij ) ::   ndex51              ! ????
47
[3]48   REAL(wp)  ::            &  ! constant values
[88]49      epsi16 = 1.e-16   ,  &
50      zzero  = 0.e0     ,  &
51      zone   = 1.e0
[3]52
[717]53   !! * Substitutions
54#   include "vectopt_loop_substitute.h90"
[508]55   !!----------------------------------------------------------------------
[717]56   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006)
[881]57   !! $ Id: $
[508]58   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
59   !!----------------------------------------------------------------------
60
[3]61CONTAINS
[508]62
[107]63#if defined key_dimgout
[508]64   !!----------------------------------------------------------------------
65   !!   'key_dimgout'                                    Direct Access file
66   !!----------------------------------------------------------------------
[881]67# include "limwri_dimg_2.h90"
[107]68#else
[508]69   !!----------------------------------------------------------------------
70   !!   Default option                                          NetCDF file
71   !!----------------------------------------------------------------------
[107]72
[881]73   SUBROUTINE lim_wri_2( kt )
[3]74      !!-------------------------------------------------------------------
[881]75      !!                    ***   ROUTINE lim_wri_2  ***
[508]76      !!               
77      !! ** Purpose :   write the sea-ice output file in NetCDF
78      !!
79      !! ** Method  :   computes the average of some variables and write
80      !!      it in the NetCDF ouput files
81      !!      CAUTION: the sea-ice time-step must be an integer fraction
82      !!      of a day
[3]83      !!-------------------------------------------------------------------
[508]84      INTEGER, INTENT(in) ::   kt     ! number of iteration
[717]85      !!
[508]86      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
87      CHARACTER(len = 40)  ::   clhstnam, clop
88      REAL(wp) ::   zsto, zsec, zjulian, zout,   &  ! temporary scalars
89         &          zindh, zinda, zindb, ztmu
90      REAL(wp), DIMENSION(1)                ::   zdept
91      REAL(wp), DIMENSION(jpi,jpj)          ::   zfield
92      REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
[3]93      !!-------------------------------------------------------------------
94
[508]95      !                                          !--------------------!
[717]96      IF( kt == nit000 ) THEN                    !   Initialisation   !
[508]97         !                                       !--------------------!
[881]98         CALL lim_wri_init_2 
[508]99                           
[3]100         zsto     = rdt_ice
101!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter
102         clop     = "ave(x)"
[717]103         zout     = nwrite * rdt_ice / nn_fsbc
[3]104         zsec     = 0.
105         niter    = 0
106         zdept(1) = 0.
107         
108         CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian )
109         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
[508]110         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
111            &           1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom)
[3]112         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid)
113         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
114         
[88]115         DO jf = 1, noumef
[717]116            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
117               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
[3]118         END DO
[508]119         CALL histend( nice )
[717]120         !
[3]121      ENDIF
[508]122      !                                          !--------------------!
123      !                                          !   Cumulate at kt   !
124      !                                          !--------------------!
[3]125
[717]126      !-- Store instantaneous values in zcmo
[3]127     
[88]128      zcmo(:,:, 1:jpnoumax ) = 0.e0 
[3]129      DO jj = 2 , jpjm1
[717]130         DO ji = fs_2 , fs_jpim1
[3]131            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
132            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
133            zindb  = zindh * zinda
134            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
135            zcmo(ji,jj,1)  = hsnif (ji,jj)
136            zcmo(ji,jj,2)  = hicif (ji,jj)
137            zcmo(ji,jj,3)  = hicifp(ji,jj)
138            zcmo(ji,jj,4)  = frld  (ji,jj)
139            zcmo(ji,jj,5)  = sist  (ji,jj)
140            zcmo(ji,jj,6)  = fbif  (ji,jj)
[717]141            zcmo(ji,jj,7)  = zindb * (  ui_ice(ji,jj  ) * tmu(ji,jj  ) + ui_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
142                                      + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[3]143                                  / ztmu 
144
[717]145            zcmo(ji,jj,8)  = zindb * (  vi_ice(ji,jj  ) * tmu(ji,jj  ) + vi_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
146                                      + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[3]147                                  / ztmu
[717]148            zcmo(ji,jj,9)  = sst_m(ji,jj)
149            zcmo(ji,jj,10) = sss_m(ji,jj)
150            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
151            zcmo(ji,jj,12) = qsr(ji,jj)
152            zcmo(ji,jj,13) = qns(ji,jj)
[3]153            ! See thersf for the coefficient
[717]154            zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
155            zcmo(ji,jj,15) = utaui_ice(ji,jj)
156            zcmo(ji,jj,16) = vtaui_ice(ji,jj)
[879]157            zcmo(ji,jj,17) = qsr_ice(ji,jj)
158            zcmo(ji,jj,18) = qns_ice(ji,jj)
[3]159            zcmo(ji,jj,19) = sprecip(ji,jj)
160         END DO
161      END DO
162      !
[508]163      ! Write the netcdf file
[3]164      !
165      niter = niter + 1
166      DO jf = 1 , noumef
167         DO jj = 1 , jpj
168            DO ji = 1 , jpi
169               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
170            END DO
171         END DO
172         
[805]173         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
[3]174            CALL lbc_lnk( zfield, 'T', -1. )
175         ELSE
176            CALL lbc_lnk( zfield, 'T',  1. )
177         ENDIF
178         
[717]179         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
[3]180         
181      END DO
182     
[717]183      IF( ( nn_fsbc * niter + nit000 - 1 ) >= nitend )   CALL histclo( nice ) 
[508]184      !
[881]185   END SUBROUTINE lim_wri_2
[508]186   
[107]187#endif
188   
[881]189   SUBROUTINE lim_wri_init_2
[3]190      !!-------------------------------------------------------------------
[881]191      !!                    ***   ROUTINE lim_wri_init_2  ***
[3]192      !!               
[508]193      !! ** Purpose :   intialisation of LIM sea-ice output
[3]194      !!
195      !! ** Method  : Read the namicewri namelist and check the parameter
196      !!       values called at the first timestep (nit000)
197      !!
198      !! ** input   :   Namelist namicewri
199      !!-------------------------------------------------------------------
200      INTEGER ::   nf      ! ???
201      TYPE FIELD 
202         CHARACTER(len = 35) :: ztitle 
203         CHARACTER(len = 8 ) :: zname         
204         CHARACTER(len = 8 ) :: zunit
205         INTEGER             :: znc   
206         REAL                :: zcmulti 
207         REAL                :: zcadd       
208      END TYPE FIELD
209      TYPE(FIELD) ::  &
210         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
211         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
212         field_13, field_14, field_15, field_16, field_17, field_18,   &
213         field_19
[88]214      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
[3]215
216      NAMELIST/namiceout/ noumef, &
217         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
218         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
219         field_13, field_14, field_15, field_16, field_17, field_18,   &
220         field_19
221      !!-------------------------------------------------------------------
222
[717]223      REWIND ( numnam_ice )                ! Read Namelist namicewri
[3]224      READ   ( numnam_ice  , namiceout )
[508]225     
[717]226      zfield( 1) = field_1
227      zfield( 2) = field_2
228      zfield( 3) = field_3
229      zfield( 4) = field_4
230      zfield( 5) = field_5
231      zfield( 6) = field_6
232      zfield( 7) = field_7
233      zfield( 8) = field_8
234      zfield( 9) = field_9
[3]235      zfield(10) = field_10
236      zfield(11) = field_11
237      zfield(12) = field_12
238      zfield(13) = field_13
239      zfield(14) = field_14
240      zfield(15) = field_15
241      zfield(16) = field_16
242      zfield(17) = field_17
243      zfield(18) = field_18
244      zfield(19) = field_19
245     
246      DO nf = 1, noumef
247         titn  (nf) = zfield(nf)%ztitle
248         nam   (nf) = zfield(nf)%zname
249         uni   (nf) = zfield(nf)%zunit
250         nc    (nf) = zfield(nf)%znc
251         cmulti(nf) = zfield(nf)%zcmulti
252         cadd  (nf) = zfield(nf)%zcadd
253      END DO
254
255      IF(lwp) THEN
256         WRITE(numout,*)
[881]257         WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
258         WRITE(numout,*) '~~~~~~~~~~~~~~'
[3]259         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
260         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
261            &            '    multiplicative constant       additive constant '
262         DO nf = 1 , noumef         
263            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
[717]264               &       '        ', cadd(nf)
[3]265         END DO
266      ENDIF
[508]267      !   
[881]268   END SUBROUTINE lim_wri_init_2
[3]269
270#else
271   !!----------------------------------------------------------------------
[881]272   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
[3]273   !!----------------------------------------------------------------------
274CONTAINS
[881]275   SUBROUTINE lim_wri_2          ! Empty routine
276   END SUBROUTINE lim_wri_2
[3]277#endif
278
279   !!======================================================================
[881]280END MODULE limwri_2
Note: See TracBrowser for help on using the repository browser.