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

Changeset 9180


Ignore:
Timestamp:
2018-01-04T15:19:26+01:00 (6 years ago)
Author:
kingr
Message:

Adding changes required to write out time-averaged assimilation background.

Location:
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r8058 r9180  
    5050   USE ice 
    5151#endif 
     52   USE asminc, ONLY: ln_avgbkg 
    5253   IMPLICIT NONE 
    5354   PRIVATE 
    5455    
    5556   PUBLIC   asm_bkg_wri   !: Write out the background state 
     57 
     58  !! * variables for calculating time means 
     59   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_tavg  , sn_tavg   
     60   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_tavg  , vn_tavg 
     61   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_tavg 
     62#if defined key_zdfgls || key_zdftke 
     63   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_tavg 
     64#endif 
     65   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_tavg 
     66   REAL(wp),SAVE :: numtimes_tavg     ! No of times to average over 
    5667 
    5768   !!---------------------------------------------------------------------- 
     
    8192      INTEGER :: inum          ! File unit number 
    8293      REAL(wp) :: zdate        ! Date 
     94      INTEGER :: ierror 
    8395      !!----------------------------------------------------------------------- 
    8496 
    85       !                                !------------------------------------------- 
    86       IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r 
    87          !                             !-----------------------------------======== 
     97      ! If creating an averaged assim bkg, initialise on first timestep 
     98      IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN 
     99         ! Allocate memory  
     100         ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     101         IF( ierror > 0 ) THEN 
     102            CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' )   ;   RETURN 
     103         ENDIF 
     104         tn_tavg(:,:,:)=0 
     105         ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     106         IF( ierror > 0 ) THEN 
     107            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' )   ;   RETURN 
     108         ENDIF 
     109         sn_tavg(:,:,:)=0 
     110         ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror ) 
     111         IF( ierror > 0 ) THEN 
     112            CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' )   ;   RETURN 
     113         ENDIF 
     114         un_tavg(:,:,:)=0 
     115         ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     116         IF( ierror > 0 ) THEN 
     117            CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' )   ;   RETURN 
     118         ENDIF 
     119         vn_tavg(:,:,:)=0 
     120         ALLOCATE( sshn_tavg(jpi,jpj), STAT=ierror ) 
     121         IF( ierror > 0 ) THEN 
     122            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sshn_tavg' )   ;   RETURN 
     123         ENDIF 
     124         sshn_tavg(:,:)=0 
     125#if defined key_zdftke 
     126         ALLOCATE( en_tavg(jpi,jpj,jpk), STAT=ierror ) 
     127         IF( ierror > 0 ) THEN 
     128            CALL ctl_stop( 'asm_wri_bkg: unable to allocate en_tavg' )   ;   RETURN 
     129         ENDIF 
     130         en_tavg(:,:,:)=0 
     131#endif 
     132         ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror ) 
     133         IF( ierror > 0 ) THEN 
     134            CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' )   ;   RETURN 
     135         ENDIF 
     136         avt_tavg(:,:,:)=0 
     137          
     138         numtimes_tavg = REAL ( nitavgbkg_r -  nn_it000 + 1 ) 
     139      ENDIF    
     140 
     141      ! If creating an averaged assim bkg, sum the contribution every timestep 
     142      IF ( ln_avgbkg ) THEN  
     143         IF (lwp) THEN 
     144              WRITE(numout,*) 'asm_wri_bkg : Summing assim bkg fields at timestep ',kt 
     145              WRITE(numout,*) '~~~~~~~~~~~~ ' 
     146         ENDIF 
     147 
     148         tn_tavg(:,:,:)        = tn_tavg(:,:,:) + tsn(:,:,:,jp_tem) / numtimes_tavg 
     149         sn_tavg(:,:,:)        = sn_tavg(:,:,:) + tsn(:,:,:,jp_sal) / numtimes_tavg 
     150         sshn_tavg(:,:)        = sshn_tavg(:,:) + sshn (:,:) / numtimes_tavg 
     151         un_tavg(:,:,:)        = un_tavg(:,:,:) + un(:,:,:) / numtimes_tavg 
     152         vn_tavg(:,:,:)        = vn_tavg(:,:,:) + vn(:,:,:) / numtimes_tavg 
     153         avt_tavg(:,:,:)        = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg 
     154#if defined key_zdftke 
     155         en_tavg(:,:,:)       = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 
     156#endif 
     157      ENDIF 
     158      
     159 
     160      ! Write out background at time step nitbkg_r or nitavgbkg_r 
     161      IF ( ( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. & 
     162      &          ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) ) THEN 
    88163         ! 
    89164         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) 
     
    97172            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib) 
    98173            ! 
    99             IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0 
    100                zdate = REAL( ndastp ) 
    101 #if defined key_zdftke 
    102                ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
    103                IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
    104                CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
    105  
    106 #endif 
     174            ! 
     175            ! Write the information 
     176            IF ( ln_avgbkg ) THEN 
     177               IF( nitavgbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitavgbkg = 0 
     178                  zdate = REAL( ndastp ) 
     179#if defined key_zdftke 
     180                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
     181                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
     182                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
     183 
     184#endif 
     185               ELSE 
     186                  zdate = REAL( ndastp ) 
     187               ENDIF 
     188               CALL iom_rstput( kt, nitavgbkg_r, inum, 'rdastp' , zdate   ) 
     189               CALL iom_rstput( kt, nitavgbkg_r, inum, 'un'     , un_tavg ) 
     190               CALL iom_rstput( kt, nitavgbkg_r, inum, 'vn'     , vn_tavg ) 
     191               CALL iom_rstput( kt, nitavgbkg_r, inum, 'tn'     , tn_tavg ) 
     192               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sn'     , sn_tavg ) 
     193               CALL iom_rstput( kt, nitavgbkg_r, inum, 'sshn'   , sshn_tavg) 
     194#if defined key_zdftke 
     195               CALL iom_rstput( kt, nitavgbkg_r, inum, 'en'     , en_tavg ) 
     196#endif 
     197               CALL iom_rstput( kt, nitavgbkg_r, inum, 'avt'    , avt_tavg) 
     198               ! 
    107199            ELSE 
    108                zdate = REAL( ndastp ) 
     200               IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0 
     201                  zdate = REAL( ndastp ) 
     202#if defined key_zdftke 
     203                  ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
     204                  IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 
     205                  CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en ) 
     206 
     207#endif 
     208               ELSE 
     209                  zdate = REAL( ndastp ) 
     210               ENDIF 
     211               CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   ) 
     212               CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                ) 
     213               CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                ) 
     214               CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     215               CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     216               CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
     217#if defined key_zdftke 
     218               CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
     219#endif 
     220               CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               ) 
     221               ! 
    109222            ENDIF 
    110             ! 
    111             !                                      ! Write the information 
    112             CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             ) 
    113             CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                ) 
    114             CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                ) 
    115             CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
    116             CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
    117             CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
    118 #if defined key_zdftke 
    119             CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
    120 #endif 
    121             CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
    122             ! 
     223             
    123224            CALL iom_close( inum ) 
     225 
    124226         ENDIF 
    125227         ! 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r8058 r9180  
    5757#endif 
    5858   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.      !: No output of the background state fields 
     59   LOGICAL, PUBLIC :: ln_avgbkg = .FALSE.      !: No output of the mean background state fields 
    5960   LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment 
    6061   LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization 
     
    8081   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
    8182   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
     83   INTEGER , PUBLIC ::   nitavgbkg   !: Number of timesteps to average assim bkg [0,nitavgbkg] 
    8284   !  
    8385   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
     
    119121      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    120122      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
     123      INTEGER :: iitavgbkg_date  ! Date YYYYMMDD of end of assim bkg averaging period 
    121124      ! 
    122125      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
     
    129132      REAL(wp), POINTER, DIMENSION(:,:) ::   hdiv   ! 2D workspace 
    130133      !! 
    131       NAMELIST/nam_asminc/ ln_bkgwri,                                      & 
     134      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg,                           & 
    132135         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
    133136         &                 ln_asmdin, ln_asmiau,                           & 
    134137         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    135          &                 ln_salfix, salfixmin, nn_divdmp 
     138         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg 
    136139      !!---------------------------------------------------------------------- 
    137140 
     
    139142      ! Read Namelist nam_asminc : assimilation increment interface 
    140143      !----------------------------------------------------------------------- 
     144 
     145      ! Set default values 
     146      ln_bkgwri = .FALSE. 
     147      ln_avgbkg = .FALSE. 
     148      ln_trainc = .FALSE. 
     149      ln_dyninc = .FALSE. 
     150      ln_sshinc = .FALSE. 
    141151      ln_seaiceinc = .FALSE. 
     152      ln_asmdin = .FALSE. 
     153      ln_asmiau = .TRUE. 
     154      ln_salfix = .FALSE. 
    142155      ln_temnofreeze = .FALSE. 
     156      salfixmin = -9999 
     157      nitbkg    = 0 
     158      nitdin    = 0       
     159      nitiaustr = 1 
     160      nitiaufin = 150 
     161      niaufn    = 0 
     162      nitavgbkg = 1 
    143163 
    144164      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment 
     
    158178         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
    159179         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
     180         WRITE(numout,*) '      Logical switch for writing mean background state         ln_avgbkg = ', ln_avgbkg 
    160181         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
    161182         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     
    168189         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 
    169190         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin 
     191         WRITE(numout,*) '      Number of timesteps to average assim bkg [0,nitavgbkg]   nitavgbkg = ', nitavgbkg 
    170192         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
    171193         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
     
    177199      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000 
    178200      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000 
     201      nitavgbkg_r = nitavgbkg + nit000 - 1  ! Averaging period referenced to nit000 
    179202 
    180203      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length 
     
    186209      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    187210      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
     211      CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date )     ! End of assim bkg averaging period referenced to ndate0 
    188212      ! 
    189213      IF(lwp) THEN 
     
    197221         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r 
    198222         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r 
     223         WRITE(numout,*) '       nitavgbkg_r = ', nitavgbkg_r 
    199224         WRITE(numout,*) 
    200225         WRITE(numout,*) '   Dates referenced to current cycle:' 
     
    206231         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    207232         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     233         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date 
    208234      ENDIF 
    209235 
     
    248274         & CALL ctl_stop( ' nitdin :',  & 
    249275         &                ' Background time step for Direct Initialization is outside', & 
     276         &                ' the cycle interval') 
     277 
     278      IF ( nitavgbkg_r > nitend ) & 
     279         & CALL ctl_stop( ' nitavgbkg_r :',  & 
     280         &                ' Assim bkg averaging period is outside', & 
    250281         &                ' the cycle interval') 
    251282 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90

    r8058 r9180  
    2929   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000 
    3030   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR 
     31   INTEGER, PUBLIC :: nitavgbkg_r   !: Averaging period for assim bkg referenced to nit000 
    3132 
    3233   !!---------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/step.F90

    r8561 r9180  
    336336      ! Dynamics                                    (tsa used as workspace) 
    337337      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     338 
     339      IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
     340 
    338341      IF( lk_dynspg_ts   )  THEN 
    339342                                                             ! revert to previously computed momentum tendencies 
     
    354357        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    355358           & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
    356         IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
    357359        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified) 
    358360        IF( lk_bdy          )  CALL bdy_dyn3d_dmp(kstp )    ! bdy damping trends 
Note: See TracChangeset for help on using the changeset viewer.