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 9473 – NEMO

Changeset 9473


Ignore:
Timestamp:
2018-04-12T18:12:29+02:00 (6 years ago)
Author:
deazer
Message:

Bug fix for 25h mean, needs reinitialzation of the mean variable at midnight

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r9181 r9473  
    2727   PRIVATE 
    2828 
    29    PUBLIC   zdf_mxl_tref  ! called by asminc.F90 
    3029   PUBLIC   zdf_mxl       ! called by step.F90 
    3130 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld_tref  !: mixed layer depth at t-points - temperature criterion [m] 
    3331   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    3432   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m] 
     
    8078        &          ll_found(jpi,jpj), ll_belowml(jpi,jpj,jpk), STAT= zdf_mxl_alloc ) 
    8179         ! 
    82          ALLOCATE(hmld_tref(jpi,jpj)) 
    8380         IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc ) 
    8481         IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
     
    8784   END FUNCTION zdf_mxl_alloc 
    8885 
    89  
    90    SUBROUTINE zdf_mxl_tref() 
    91       !!---------------------------------------------------------------------- 
    92       !!                  ***  ROUTINE zdf_mxl_tref  *** 
    93       !!                    
    94       !! ** Purpose :   Compute the mixed layer depth with temperature criteria. 
    95       !! 
    96       !! ** Method  :   The temperature-defined mixed layer depth is required 
    97       !!                   when assimilating SST in a 2D analysis.  
    98       !! 
    99       !! ** Action  :   hmld_tref 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    103       REAL(wp) ::   t_ref               ! Reference temperature   
    104       REAL(wp) ::   temp_c = 0.2        ! temperature criterion for mixed layer depth   
    105       !!---------------------------------------------------------------------- 
    106       ! 
    107       ! Initialise array 
    108       IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_tref : unable to allocate arrays' ) 
    109        
    110       !For the AMM model assimiation uses a temperature based mixed layer depth   
    111       !This is defined here   
    112       DO jj = 1, jpj   
    113          DO ji = 1, jpi   
    114            hmld_tref(ji,jj)=fsdept(ji,jj,1  )    
    115            IF(ssmask(ji,jj) > 0.)THEN   
    116              t_ref=tsn(ji,jj,1,jp_tem)  
    117              DO jk=2,jpk   
    118                IF(ssmask(ji,jj)==0.)THEN   
    119                   hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
    120                   EXIT   
    121                ELSEIF( ABS(tsn(ji,jj,jk,jp_tem)-t_ref) < temp_c)THEN   
    122                   hmld_tref(ji,jj)=fsdept(ji,jj,jk )   
    123                ELSE   
    124                   EXIT   
    125                ENDIF   
    126              ENDDO   
    127            ENDIF   
    128          ENDDO   
    129       ENDDO 
    130  
    131    END SUBROUTINE zdf_mxl_tref 
    13286 
    13387   SUBROUTINE zdf_mxl( kt ) 
     
    597551            IF( i_cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN 
    598552               i_cnt_25h = 1  
     553               DO jn = 1, nn_mld_diag 
     554                     hmld_zint_25h(:,:,jn) = hmld_zint(:,:) 
     555               ENDDO 
    599556            ENDIF 
    600557         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.