SUBROUTINE lim_wri_2(kt) !!---------------------------------------------------------------------- !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- !!------------------------------------------------------------------- !! 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 !!------------------------------------------------------------------- USE diadimg ! use of dia_wri_dimg INTEGER, INTENT(in) :: kt ! number of iteration INTEGER , SAVE :: nmoyice !: counter for averaging INTEGER , SAVE :: nwf !: number of fields to write on disk INTEGER , SAVE, DIMENSION(:), ALLOCATABLE :: nsubindex !: subindex to be saved INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index INTEGER :: iyear, iday, imon ! INTEGER :: ialloc CHARACTER(LEN=80) :: clname, cltext, clmode REAL(wp), DIMENSION(1) :: zdept REAL(wp) :: zsto, zsec, zjulian,zout REAL(wp) :: zindh,zinda,zindb, ztmu REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: zcmo !ARPDBGWORK REAL(wp), DIMENSION(jpi,jpj) :: zfield #if ! defined key_diainstant LOGICAL, PARAMETER :: ll_dia_inst=.false. ! local logical variable #else LOGICAL, PARAMETER :: ll_dia_inst=.true. #endif !!------------------------------------------------------------------- IF( .NOT. ALLOCATED(rcmoy) )THEN ALLOCATE(rcmoy(jpi,jpj,jpnoumax), STAT=ialloc ) ! IF( lk_mpp ) CALL mpp_sum ( ialloc ) IF( ialloc /= 0 ) CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') rcmoy(:,:,:) = 0._wp ENDIF IF( kt == nit000 ) THEN ! CALL lim_wri_init_2 nwf = 0 ii = 0 IF(lwp ) THEN WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' WRITE(numout,*) '~~~~~~~~' WRITE(numout,*) ' According to namelist_ice, following fields saved:' DO jf =1, noumef IF (nc(jf) == 1 ) THEN WRITE(numout,* ) ' -',titn(jf), nam(jf), uni(jf) ENDIF END DO ENDIF DO jf = 1, noumef IF (nc(jf) == 1 ) nwf = nwf + 1 END DO ALLOCATE( nsubindex (nwf) ) DO jf = 1, noumef IF (nc(jf) == 1 ) THEN ii = ii +1 nsubindex(ii) = jf END IF END DO zsto = rdt_ice zout = nwrite * rdt_ice / nn_fsbc zsec = 0. niter = 0 zdept(1) = 0. nmoyice = 0 ENDIF #if ! defined key_diainstant !-- calculs des valeurs instantanees zcmo(:,:, 1:jpnoumax ) = 0.e0 DO jj = 2 , jpjm1 DO ji = 2 , jpim1 ! NO vector opt. 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_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) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce zcmo(ji,jj,15) = utau_ice(ji,jj) zcmo(ji,jj,16) = vtau_ice(ji,jj) zcmo(ji,jj,17) = qsr_ice(ji,jj,1) zcmo(ji,jj,18) = qns_ice(ji,jj,1) zcmo(ji,jj,19) = sprecip(ji,jj) END DO END DO ! Cumulates values between outputs rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:) nmoyice = nmoyice + 1 ! compute mean value if it is time to write on file IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice) #else IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN ! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 DO jj = 2 , jpjm1 DO ji = 2 , jpim1 ! NO vector opt. 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) ) ) rcmoy(ji,jj,1) = hsnif (ji,jj) rcmoy(ji,jj,2) = hicif (ji,jj) rcmoy(ji,jj,3) = hicifp(ji,jj) rcmoy(ji,jj,4) = frld (ji,jj) rcmoy(ji,jj,5) = sist (ji,jj) rcmoy(ji,jj,6) = fbif (ji,jj) rcmoy(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 rcmoy(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 rcmoy(ji,jj,9) = sst_m(ji,jj) rcmoy(ji,jj,10) = sss_m(ji,jj) rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) rcmoy(ji,jj,12) = qsr(ji,jj) rcmoy(ji,jj,13) = qns(ji,jj) ! See thersf for the coefficient rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce rcmoy(ji,jj,15) = utau_ice(ji,jj) rcmoy(ji,jj,16) = vtau_ice(ji,jj) rcmoy(ji,jj,17) = qsr_ice(ji,jj,1) rcmoy(ji,jj,18) = qns_ice(ji,jj,1) rcmoy(ji,jj,19) = sprecip(ji,jj) END DO END DO #endif ! niter = niter + 1 DO jf = 1 , noumef zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 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 rcmoy(:,:,jf) = zfield(:,:) END DO IF (ll_dia_inst) THEN clmode='instantaneous' ELSE WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average' END IF iyear = ndastp/10000 imon = (ndastp-iyear*10000)/100 iday = ndastp - imon*100 - iyear*10000 WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode) CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex) 9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") rcmoy(:,:,:) = 0.0 nmoyice = 0 END IF ! MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! END SUBROUTINE lim_wri_2