MODULE limwri !!====================================================================== !! *** MODULE limwri *** !! Ice diagnostics : write ice output files !!====================================================================== !!---------------------------------------------------------------------- !! LIM 2.0, UCL-LOCEAN-IPSL (2005) !! $Header$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- #if defined key_ice_lim !!---------------------------------------------------------------------- !! 'key_ice_lim' LIM sea-ice model !!---------------------------------------------------------------------- !! lim_wri : write of the diagnostics variables in ouput file !! lim_wri_init : initialization and namelist read !!---------------------------------------------------------------------- !! * Modules used USE ioipsl USE dianam ! build name of file (routine) USE phycst USE dom_oce USE daymod USE in_out_manager USE ice_oce ! ice variables USE flx_oce USE dom_ice USE ice USE iceini USE lbclnk IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC lim_wri ! routine called by lim_step.F90 !! * Module variables INTEGER, PARAMETER :: & !: jpnoumax = 40 !: maximum number of variable for ice output INTEGER :: & noumef ! number of fields REAL(wp) , DIMENSION(jpnoumax) :: & cmulti , & ! multiplicative constant cadd ! additive constant CHARACTER(len = 35), DIMENSION(jpnoumax) :: & titn ! title of the field CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & nam ! name of the field CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: & uni ! unit of the field INTEGER , DIMENSION(jpnoumax) :: & nc ! switch for saving field ( = 1 ) or not ( = 0 ) REAL(wp) :: & ! constant values epsi16 = 1.e-16 , & zzero = 0.e0 , & zone = 1.e0 !!------------------------------------------------------------------- CONTAINS #if defined key_dimgout # include "limwri_dimg.h90" #else SUBROUTINE lim_wri !!------------------------------------------------------------------- !! This routine computes the average of some variables and write it !! on the ouput files. !! ATTENTION cette routine n'est valable que si le pas de temps est !! egale a une fraction entiere de 1 jours. !! Diff 1-D 3-D : suppress common also included in etat !! suppress cmoymo 11-18 !! modif : 03/06/98 !!------------------------------------------------------------------- !! * Local variables REAL(wp),DIMENSION(1) :: zdept REAL(wp) :: & zsto, zsec, zjulian,zout, & zindh,zinda,zindb, & ztmu REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & zcmo REAL(wp), DIMENSION(jpi,jpj) :: & zfield INTEGER :: ji, jj, jf ! dummy loop indices CHARACTER(len = 40) :: & clhstnam, clop INTEGER , SAVE :: & nice, nhorid, ndim, niter, ndepid INTEGER , DIMENSION( jpij ) , SAVE :: & ndex51 !!------------------------------------------------------------------- IF ( numit == nstart ) THEN CALL lim_wri_init !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72 ! 1) INITIALIZATIONS. | !----------------------------------------------------------------------- !-- essai NetCDF zsto = rdt_ice !!Chris clop = "ave(only(x))" !ibug namelist parameter a ajouter clop = "ave(x)" zout = nwrite * rdt_ice / nfice zsec = 0. niter = 0 zdept(1) = 0. CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian ) CALL dia_nam ( clhstnam, nwrite, 'icemod' ) CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) DO jf = 1, noumef IF ( nc(jf) == 1 ) THEN CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) ENDIF END DO CALL histend(nice) ENDIF !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72 !--2. Computation of instantaneous values | !----------------------------------------------------------------------- IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit WRITE(numout,*) '~~~~~~~ ' ENDIF !-- calculs des valeurs instantanees zcmo(:,:, 1:jpnoumax ) = 0.e0 DO jj = 2 , jpjm1 DO ji = 2 , jpim1 zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) zindb = zindh * zinda ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) zcmo(ji,jj,1) = hsnif (ji,jj) zcmo(ji,jj,2) = hicif (ji,jj) zcmo(ji,jj,3) = hicifp(ji,jj) zcmo(ji,jj,4) = frld (ji,jj) zcmo(ji,jj,5) = sist (ji,jj) zcmo(ji,jj,6) = fbif (ji,jj) zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & / ztmu zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) & + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & / ztmu zcmo(ji,jj,9) = sst_io(ji,jj) zcmo(ji,jj,10) = sss_io(ji,jj) zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) zcmo(ji,jj,12) = fsolar (ji,jj) zcmo(ji,jj,13) = fnsolar(ji,jj) ! See thersf for the coefficient zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce zcmo(ji,jj,15) = gtaux(ji,jj) zcmo(ji,jj,16) = gtauy(ji,jj) zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) zcmo(ji,jj,19) = sprecip(ji,jj) END DO END DO ! ! ecriture d'un fichier netcdf ! niter = niter + 1 DO jf = 1 , noumef DO jj = 1 , jpj DO ji = 1 , jpi zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf) END DO END DO IF ( jf == 7 .OR. jf == 8 .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR. & jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN CALL lbc_lnk( zfield, 'T', -1. ) ELSE CALL lbc_lnk( zfield, 'T', 1. ) ENDIF IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) END DO IF ( ( nfice * niter + nit000 - 1 ) >= nitend ) THEN CALL histclo( nice ) ENDIF END SUBROUTINE lim_wri #endif SUBROUTINE lim_wri_init !!------------------------------------------------------------------- !! *** ROUTINE lim_wri_init *** !! !! ** Purpose : ??? !! !! ** Method : Read the namicewri namelist and check the parameter !! values called at the first timestep (nit000) !! !! ** input : Namelist namicewri !! !! history : !! 8.5 ! 03-08 (C. Ethe) original code !!------------------------------------------------------------------- !! * Local declarations INTEGER :: nf ! ??? TYPE FIELD CHARACTER(len = 35) :: ztitle CHARACTER(len = 8 ) :: zname CHARACTER(len = 8 ) :: zunit INTEGER :: znc REAL :: zcmulti REAL :: zcadd END TYPE FIELD TYPE(FIELD) :: & field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , & field_7 , field_8 , field_9 , field_10, field_11, field_12, & field_13, field_14, field_15, field_16, field_17, field_18, & field_19 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield NAMELIST/namiceout/ noumef, & field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , & field_7 , field_8 , field_9 , field_10, field_11, field_12, & field_13, field_14, field_15, field_16, field_17, field_18, & field_19 !!------------------------------------------------------------------- ! Read Namelist namicewri REWIND ( numnam_ice ) READ ( numnam_ice , namiceout ) zfield(1) = field_1 zfield(2) = field_2 zfield(3) = field_3 zfield(4) = field_4 zfield(5) = field_5 zfield(6) = field_6 zfield(7) = field_7 zfield(8) = field_8 zfield(9) = field_9 zfield(10) = field_10 zfield(11) = field_11 zfield(12) = field_12 zfield(13) = field_13 zfield(14) = field_14 zfield(15) = field_15 zfield(16) = field_16 zfield(17) = field_17 zfield(18) = field_18 zfield(19) = field_19 DO nf = 1, noumef titn (nf) = zfield(nf)%ztitle nam (nf) = zfield(nf)%zname uni (nf) = zfield(nf)%zunit nc (nf) = zfield(nf)%znc cmulti(nf) = zfield(nf)%zcmulti cadd (nf) = zfield(nf)%zcadd END DO IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' WRITE(numout,*) '~~~~~~~~~~~~' WRITE(numout,*) ' number of fields to be stored noumef = ', noumef WRITE(numout,*) ' title name unit Saving (1/0) ', & & ' multiplicative constant additive constant ' DO nf = 1 , noumef WRITE(numout,*) ' ', titn(nf), ' ', nam(nf),' ', uni(nf),' ', nc(nf),' ', cmulti(nf), & ' ', cadd(nf) END DO ENDIF END SUBROUTINE lim_wri_init #else !!---------------------------------------------------------------------- !! Default option : Empty module NO LIM sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE lim_wri ! Empty routine END SUBROUTINE lim_wri #endif !!====================================================================== END MODULE limwri