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 11134 for branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 – NEMO

Ignore:
Timestamp:
2019-06-18T17:48:39+02:00 (5 years ago)
Author:
jcastill
Message:

Full set of changes as in the original branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r11132 r11134  
    4040#endif 
    4141   USE sbc_oce          ! Surface boundary condition variables. 
     42   USE zdfmxl, ONLY :  &   
     43   &  hmld_tref,       &    
     44#if defined key_karaml 
     45   &  hmld_kara,       & 
     46   &  ln_kara,         & 
     47#endif    
     48   &  hmld,            &  
     49   &  hmlp,            & 
     50   &  hmlpt 
     51#if defined key_bdy  
     52   USE bdy_oce, ONLY: bdytmask   
     53#endif   
    4254 
    4355   IMPLICIT NONE 
     
    5769#endif 
    5870   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields 
     71   LOGICAL, PUBLIC :: ln_avgbkg = .FALSE.      !: No output of the mean background state fields 
    5972   LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment 
    6073   LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization 
     
    8093   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
    8194   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
     95   INTEGER , PUBLIC ::   nitavgbkg   !: Number of timesteps to average assim bkg [0,nitavgbkg] 
    8296   !  
    8397   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
     
    87101   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment 
    88102   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc 
     103 
     104   INTEGER :: mld_choice        = 4   !: choice of mld criteria to use for physics assimilation 
     105                                      !: 1) hmld      - Turbocline/mixing depth                           [W points] 
     106                                      !: 2) hmlp      - Density criterion (0.01 kg/m^3 change from 10m)   [W points] 
     107                                      !: 3) hmld_kara - Kara MLD                                          [Interpolated] 
     108                                      !: 4) hmld_tref - Temperature criterion (0.2 K change from surface) [T points] 
     109 
    89110 
    90111   !! * Substitutions 
     
    119140      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    120141      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
     142      INTEGER :: isurfstat       ! Local integer for status of reading surft variable 
     143      INTEGER :: iitavgbkg_date  ! Date YYYYMMDD of end of assim bkg averaging period 
    121144      ! 
    122145      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
     
    127150      REAL(wp) :: zdate_inc    ! Time axis in increments file 
    128151      ! 
     152      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: &  
     153          &       t_bkginc_2d  ! file for reading in 2D   
     154      !                        ! temperature increments  
     155      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: &  
     156          &       z_mld     ! Mixed layer depth  
     157           
    129158      REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace 
    130       !! 
    131       NAMELIST/nam_asminc/ ln_bkgwri,                                      & 
     159      ! 
     160      LOGICAL :: lk_surft      ! Logical: T => Increments file contains surft variable  
     161                               !               so only apply surft increments. 
     162      !! 
     163      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg,                           & 
    132164         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
    133165         &                 ln_asmdin, ln_asmiau,                           & 
    134166         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    135          &                 ln_salfix, salfixmin, nn_divdmp 
     167         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice 
    136168      !!---------------------------------------------------------------------- 
    137169 
     
    139171      ! Read Namelist nam_asminc : assimilation increment interface 
    140172      !----------------------------------------------------------------------- 
     173 
     174      ! Set default values 
     175      ln_bkgwri = .FALSE. 
     176      ln_avgbkg = .FALSE. 
     177      ln_trainc = .FALSE. 
     178      ln_dyninc = .FALSE. 
     179      ln_sshinc = .FALSE. 
    141180      ln_seaiceinc = .FALSE. 
     181      ln_asmdin = .FALSE. 
     182      ln_asmiau = .TRUE. 
     183      ln_salfix = .FALSE. 
    142184      ln_temnofreeze = .FALSE. 
     185      salfixmin = -9999 
     186      nitbkg    = 0 
     187      nitdin    = 0       
     188      nitiaustr = 1 
     189      nitiaufin = 150 
     190      niaufn    = 0 
     191      nitavgbkg = 1 
    143192 
    144193      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment 
     
    158207         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
    159208         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
     209         WRITE(numout,*) '      Logical switch for writing mean background state         ln_avgbkg = ', ln_avgbkg 
    160210         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
    161211         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     
    168218         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 
    169219         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin 
     220         WRITE(numout,*) '      Number of timesteps to average assim bkg [0,nitavgbkg]   nitavgbkg = ', nitavgbkg 
    170221         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
    171222         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
    172223         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin 
     224         WRITE(numout,*) '      Choice of MLD for physics assimilation                  mld_choice = ', mld_choice 
    173225      ENDIF 
    174226 
     
    177229      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000 
    178230      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000 
     231      nitavgbkg_r = nitavgbkg + nit000 - 1  ! Averaging period referenced to nit000 
    179232 
    180233      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length 
     
    186239      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    187240      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
     241      CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date )     ! End of assim bkg averaging period referenced to ndate0 
    188242      ! 
    189243      IF(lwp) THEN 
     
    197251         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r 
    198252         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r 
     253         WRITE(numout,*) '       nitavgbkg_r = ', nitavgbkg_r 
    199254         WRITE(numout,*) 
    200255         WRITE(numout,*) '   Dates referenced to current cycle:' 
     
    206261         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    207262         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     263         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date 
    208264      ENDIF 
    209265 
     
    248304         & CALL ctl_stop( ' nitdin :',  & 
    249305         &                ' Background time step for Direct Initialization is outside', & 
     306         &                ' the cycle interval') 
     307 
     308      IF ( nitavgbkg_r > nitend ) & 
     309         & CALL ctl_stop( ' nitavgbkg_r :',  & 
     310         &                ' Assim bkg averaging period is outside', & 
    250311         &                ' the cycle interval') 
    251312 
     
    327388      !-------------------------------------------------------------------- 
    328389 
    329       ALLOCATE( t_bkginc(jpi,jpj,jpk) ) 
    330       ALLOCATE( s_bkginc(jpi,jpj,jpk) ) 
    331       ALLOCATE( u_bkginc(jpi,jpj,jpk) ) 
    332       ALLOCATE( v_bkginc(jpi,jpj,jpk) ) 
    333       ALLOCATE( ssh_bkginc(jpi,jpj)   ) 
    334       ALLOCATE( seaice_bkginc(jpi,jpj)) 
     390      IF ( ln_trainc ) THEN 
     391         ALLOCATE( t_bkginc(jpi,jpj,jpk) ) 
     392         ALLOCATE( s_bkginc(jpi,jpj,jpk) ) 
     393         t_bkginc(:,:,:) = 0.0 
     394         s_bkginc(:,:,:) = 0.0 
     395      ENDIF 
     396      IF ( ln_dyninc ) THEN  
     397         ALLOCATE( u_bkginc(jpi,jpj,jpk) ) 
     398         ALLOCATE( v_bkginc(jpi,jpj,jpk) ) 
     399         u_bkginc(:,:,:) = 0.0 
     400         v_bkginc(:,:,:) = 0.0 
     401      ENDIF 
     402      IF ( ln_sshinc ) THEN 
     403         ALLOCATE( ssh_bkginc(jpi,jpj)   ) 
     404         ssh_bkginc(:,:) = 0.0 
     405      ENDIF 
     406      IF ( ln_seaiceinc ) THEN  
     407         ALLOCATE( seaice_bkginc(jpi,jpj)) 
     408         seaice_bkginc(:,:) = 0.0 
     409      ENDIF 
    335410#if defined key_asminc 
    336411      ALLOCATE( ssh_iau(jpi,jpj)      ) 
    337 #endif 
    338       t_bkginc(:,:,:) = 0.0 
    339       s_bkginc(:,:,:) = 0.0 
    340       u_bkginc(:,:,:) = 0.0 
    341       v_bkginc(:,:,:) = 0.0 
    342       ssh_bkginc(:,:) = 0.0 
    343       seaice_bkginc(:,:) = 0.0 
    344 #if defined key_asminc 
    345412      ssh_iau(:,:)    = 0.0 
    346413#endif 
     
    378445 
    379446         IF ( ln_trainc ) THEN    
    380             CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 ) 
    381             CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 ) 
    382             ! Apply the masks 
    383             t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:) 
    384             s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:) 
    385             ! Set missing increments to 0.0 rather than 1e+20 
    386             ! to allow for differences in masks 
    387             WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0 
    388             WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0 
     447 
     448            !Test if the increments file contains the surft variable. 
     449            isurfstat = iom_varid( inum, 'bckinsurft', ldstop = .FALSE. ) 
     450            IF ( isurfstat == -1 ) THEN 
     451               lk_surft = .FALSE. 
     452            ELSE 
     453               lk_surft = .TRUE. 
     454               CALL ctl_warn( ' Applying 2D temperature increment to bottom of ML: ', & 
     455            &                 ' bckinsurft found in increments file.' ) 
     456            ENDIF              
     457 
     458            IF (lk_surft) THEN  
     459                 
     460               ALLOCATE(z_mld(jpi,jpj))  
     461               SELECT CASE(mld_choice)  
     462               CASE(1)  
     463                  z_mld = hmld  
     464               CASE(2)  
     465                  z_mld = hmlp  
     466               CASE(3)  
     467#if defined key_karaml 
     468                  IF ( ln_kara ) THEN 
     469                     z_mld = hmld_kara 
     470                  ELSE 
     471                     CALL ctl_stop("Kara mixed layer not calculated as ln_kara=.false.") 
     472                  ENDIF 
     473#else 
     474                  CALL ctl_stop("Kara mixed layer not defined in current version of NEMO")  ! JW: Safety feature, should be removed 
     475                                                                                            ! once the Kara mixed layer is available  
     476#endif 
     477               CASE(4)  
     478                  z_mld = hmld_tref  
     479               END SELECT        
     480                       
     481               ALLOCATE( t_bkginc_2d(jpi,jpj) )  
     482               CALL iom_get( inum, jpdom_autoglo, 'bckinsurft', t_bkginc_2d, 1)  
     483#if defined key_bdy                 
     484               DO jk = 1,jpkm1  
     485                  WHERE( z_mld(:,:) > fsdepw(:,:,jk) )  
     486                     t_bkginc(:,:,jk) = t_bkginc_2d(:,:) * 0.5 * & 
     487                     &       ( 1 + cos( (fsdept(:,:,jk)/z_mld(:,:) ) * rpi ) ) 
     488                      
     489                     t_bkginc(:,:,jk) = t_bkginc(:,:,jk) * bdytmask(:,:)  
     490                  ELSEWHERE  
     491                     t_bkginc(:,:,jk) = 0.  
     492                  ENDWHERE  
     493               ENDDO  
     494#else  
     495               t_bkginc(:,:,:) = 0.  
     496#endif                 
     497               s_bkginc(:,:,:) = 0.  
     498                 
     499               DEALLOCATE(z_mld, t_bkginc_2d)  
     500             
     501            ELSE  
     502                
     503               CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 ) 
     504               CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 ) 
     505               ! Apply the masks 
     506               t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:) 
     507               s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:) 
     508               ! Set missing increments to 0.0 rather than 1e+20 
     509               ! to allow for differences in masks 
     510               WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0 
     511               WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0 
     512          
     513            ENDIF 
     514 
    389515         ENDIF 
    390516 
     
    8921018            ENDIF 
    8931019 
     1020#if defined key_asminc 
     1021         ELSE 
     1022            ssh_iau(:,:) = 0._wp 
     1023#endif 
    8941024         ENDIF 
    8951025 
Note: See TracChangeset for help on using the changeset viewer.