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.
Changeset 3564 for trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90 – NEMO

Ignore:
Timestamp:
2012-11-15T18:42:30+01:00 (11 years ago)
Author:
rblod
Message:

fix output average with EVP, see ticket #908

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r3558 r3564  
    1414    !!  modif : 03/06/98 
    1515    !!------------------------------------------------------------------- 
    16     USE  diadimg       ! use of dia_wri_dimg 
    17     USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     16    USE  diadimg                ! use of dia_wri_dimg 
    1817 
    1918    INTEGER, INTENT(in) ::   kt     ! number of iteration 
     
    2120    INTEGER , SAVE ::   nmoyice   !: counter for averaging 
    2221    INTEGER , SAVE ::   nwf       !: number of fields to write on disk 
    23     INTEGER , SAVE, DIMENSION(:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
     22    INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
    2423    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    2524    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy 
     
    3130    REAL(wp), DIMENSION(1) ::   zdept 
    3231    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 
     32    REAL(wp) ::   zindh, zinda, zindb, ztmu 
     33    REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield 
    3634 
    3735#if ! defined key_diainstant 
     
    4644       IF( lk_mpp      )   CALL mpp_sum ( ialloc  ) 
    4745       IF( ialloc /= 0 )   CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays') 
    48        rcmoy(:,:,:) = 0._wp 
    4946    ENDIF 
    5047 
    51     IF( kt == nit000 ) THEN  
     48    CALL wrk_alloc( jpi, jpj, zfield ) 
     49 
     50    IF ( kt == nit000 ) THEN  
    5251       ! 
    5352       CALL lim_wri_init_2  
     
    5655       ii  = 0 
    5756 
    58        IF(lwp ) THEN 
     57       IF (lwp ) THEN 
    5958          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg' 
    6059          WRITE(numout,*) '~~~~~~~~' 
     
    8079       END DO 
    8180 
     81       rcmoy(:,:,:) = 0.0_wp 
    8282       zsto     = rdt_ice 
    8383       zout     = nwrite * rdt_ice / nn_fsbc 
     
    9090 
    9191#if ! defined key_diainstant  
    92     !-- calculs des valeurs instantanees 
     92    !-- Compute mean values 
    9393 
    9494    zcmo(:,:, 1:jpnoumax ) = 0.e0  
    9595    DO jj = 2 , jpjm1 
    96        DO ji = 2 , jpim1   ! NO vector opt. 
     96       DO ji = 2 , jpim1 
    9797          zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9898          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9999          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) ) )  
    101100          zcmo(ji,jj,1)  = hsnif (ji,jj) 
    102101          zcmo(ji,jj,2)  = hicif (ji,jj) 
     
    105104          zcmo(ji,jj,5)  = sist  (ji,jj) 
    106105          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  )   & 
     106          IF (lk_lim2_vp) THEN 
     107            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     108            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    108109             &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    109110               / ztmu  
    110111 
    111           zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     112            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    112113             &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    113114               / ztmu 
     115           ELSE 
     116            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 
     117            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 
     118           ENDIF 
     119 
    114120          zcmo(ji,jj,9)  = sst_m(ji,jj) 
    115121          zcmo(ji,jj,10) = sss_m(ji,jj) 
     
    137143          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
    138144          DO jj = 2 , jpjm1 
    139              DO ji = 2 , jpim1   ! NO vector opt. 
     145             DO ji = 2 , jpim1 
    140146                zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    141147                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    142148                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) ) ) 
    144149                rcmoy(ji,jj,1)  = hsnif (ji,jj) 
    145150                rcmoy(ji,jj,2)  = hicif (ji,jj) 
     
    148153                rcmoy(ji,jj,5)  = sist  (ji,jj) 
    149154                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 
     155                IF (lk_lim2_vp) THEN 
     156                   ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     157                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     158                      &                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     159                        / ztmu 
     160 
     161                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     162                      &                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     163                       / ztmu 
     164                ELSE 
     165                   rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) )/ 2.0 
     166                   rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) )/ 2.0 
     167                ENDIF 
    157168                rcmoy(ji,jj,9)  = sst_m(ji,jj) 
    158169                rcmoy(ji,jj,10) = sss_m(ji,jj) 
     
    177188             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
    178189 
    179              IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
     190             SELECT CASE (jf)  
     191             CASE ( 7, 8, 15, 16 ) ! velocity or stress fields (vectors) 
    180192                CALL lbc_lnk( zfield, 'T', -1. ) 
    181              ELSE  
     193             CASE DEFAULT          ! scalar fields 
    182194                CALL lbc_lnk( zfield, 'T',  1. ) 
    183              ENDIF 
     195             END SELECT 
    184196             rcmoy(:,:,jf) = zfield(:,:) 
    185197          END DO 
     
    201213          nmoyice = 0  
    202214       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 
     215       CALL wrk_dealloc( jpi,jpj, zfield ) 
    203216 
    204217     END SUBROUTINE lim_wri_2 
Note: See TracChangeset for help on using the changeset viewer.