MODULE limwri_2 !!====================================================================== !! *** MODULE limwri_2 *** !! Ice diagnostics : write ice output files !!====================================================================== !! history : 2.0 ! 03-08 (C. Ethe) original code !! 2.0 ! 04-10 (C. Ethe ) 1D configuration !!------------------------------------------------------------------- #if defined key_lim2 !!---------------------------------------------------------------------- !! 'key_lim2' LIM 2.0 sea-ice model !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! lim_wri_2 : write of the diagnostics variables in ouput file !! lim_wri_init_2 : initialization and namelist read !!---------------------------------------------------------------------- USE phycst USE dom_oce USE daymod USE ice_oce ! ice variables USE sbc_oce USE sbc_ice USE dom_ice_2 USE ice_2 USE lbclnk USE dianam ! build name of file (routine) USE in_out_manager USE ioipsl IMPLICIT NONE PRIVATE PUBLIC lim_wri_2 ! routine called by sbc_ice_lim_2 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 ) INTEGER :: nice, nhorid, ndim, niter, ndepid ! ???? INTEGER , DIMENSION( jpij ) :: ndex51 ! ???? REAL(wp) :: & ! constant values epsi16 = 1.e-16 , & zzero = 0.e0 , & zone = 1.e0 !! * Substitutions # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! LIM 2.0, UCL-LOCEAN-IPSL (2006) !! $ Id: $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS #if defined key_dimgout !!---------------------------------------------------------------------- !! 'key_dimgout' Direct Access file !!---------------------------------------------------------------------- # include "limwri_dimg_2.h90" #else !!---------------------------------------------------------------------- !! Default option NetCDF file !!---------------------------------------------------------------------- SUBROUTINE lim_wri_2( kt ) !!------------------------------------------------------------------- !! *** ROUTINE lim_wri_2 *** !! !! ** Purpose : write the sea-ice output file in NetCDF !! !! ** Method : computes the average of some variables and write !! it in the NetCDF ouput files !! CAUTION: the sea-ice time-step must be an integer fraction !! of a day !!------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! number of iteration !! INTEGER :: ji, jj, jf ! dummy loop indices CHARACTER(len = 40) :: clhstnam, clop REAL(wp) :: zsto, zsec, zjulian, zout, & ! temporary scalars & zindh, zinda, zindb, ztmu REAL(wp), DIMENSION(1) :: zdept REAL(wp), DIMENSION(jpi,jpj) :: zfield REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !!------------------------------------------------------------------- ! !--------------------! IF( kt == nit000 ) THEN ! Initialisation ! ! !--------------------! CALL lim_wri_init_2 zsto = rdt_ice !!Chris clop = "ave(only(x))" !ibug namelist parameter a ajouter clop = "ave(x)" zout = nwrite * rdt_ice / nn_fsbc 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 ) CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & & , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) END DO CALL histend( nice ) ! ENDIF ! !--------------------! ! ! Cumulate at kt ! ! !--------------------! !-- Store instantaneous values in zcmo zcmo(:,:, 1:jpnoumax ) = 0.e0 DO jj = 2 , jpjm1 DO ji = fs_2 , fs_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 * ( ui_ice(ji,jj ) * tmu(ji,jj ) + ui_ice(ji+1,jj ) * tmu(ji+1,jj ) & + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & / ztmu zcmo(ji,jj,8) = zindb * ( vi_ice(ji,jj ) * tmu(ji,jj ) + vi_ice(ji+1,jj ) * tmu(ji+1,jj ) & + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & / ztmu zcmo(ji,jj,9) = sst_m(ji,jj) zcmo(ji,jj,10) = sss_m(ji,jj) zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) zcmo(ji,jj,12) = qsr(ji,jj) zcmo(ji,jj,13) = qns(ji,jj) ! See thersf for the coefficient zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce !!gm ??? zcmo(ji,jj,15) = utaui_ice(ji,jj) zcmo(ji,jj,16) = vtaui_ice(ji,jj) zcmo(ji,jj,17) = qsr_ice(ji,jj) zcmo(ji,jj,18) = qns_ice(ji,jj) zcmo(ji,jj,19) = sprecip(ji,jj) END DO END DO ! ! Write the netcdf file ! 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 == 15 .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( ( nn_fsbc * niter + nit000 - 1 ) >= nitend ) CALL histclo( nice ) ! END SUBROUTINE lim_wri_2 #endif SUBROUTINE lim_wri_init_2 !!------------------------------------------------------------------- !! *** ROUTINE lim_wri_init_2 *** !! !! ** Purpose : intialisation of LIM sea-ice output !! !! ** Method : Read the namicewri namelist and check the parameter !! values called at the first timestep (nit000) !! !! ** input : Namelist namicewri !!------------------------------------------------------------------- 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 !!------------------------------------------------------------------- REWIND ( numnam_ice ) ! Read Namelist namicewri 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_2 : 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_2 #else !!---------------------------------------------------------------------- !! Default option : Empty module NO LIM 2.0 sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE lim_wri_2 ! Empty routine END SUBROUTINE lim_wri_2 #endif !!====================================================================== END MODULE limwri_2