Changeset 6762


Ignore:
Timestamp:
2016-06-30T15:45:10+02:00 (4 years ago)
Author:
kingr
Message:

Added code to asmbkg.F90 and asminc.F90 to allow writing of average fields (over namelist-specified window) into assimilation background file.

Location:
branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/NEMO/OPA_SRC/ASM
Files:
2 edited

Legend:

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

    r6761 r6762  
    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 :: gcx_tavg 
     67   REAL(wp),SAVE :: numtimes_tavg     ! No of times to average over 
    5668 
    5769   !!---------------------------------------------------------------------- 
     
    8395      !!----------------------------------------------------------------------- 
    8496 
    85       !                                !------------------------------------------- 
    86       IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r 
    87          !                             !-----------------------------------======== 
     97 
     98      ! If creating an averaged assim bkg, initialise on first timestep 
     99      IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN 
     100         ! Allocate memory  
     101         ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     102         IF( ierror > 0 ) THEN 
     103            CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' )   ;   RETURN 
     104         ENDIF 
     105         tn_tavg=0 
     106         ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     107         IF( ierror > 0 ) THEN 
     108            CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' )   ;   RETURN 
     109         ENDIF 
     110         sn_tavg=0 
     111         ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror ) 
     112         IF( ierror > 0 ) THEN 
     113            CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' )   ;   RETURN 
     114         ENDIF 
     115         un_tavg=0 
     116         ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror ) 
     117         IF( ierror > 0 ) THEN 
     118            CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' )   ;   RETURN 
     119         ENDIF 
     120         vn_tavg=0 
     121         ALLOCATE( ssh_tavg(jpi,jpj), STAT=ierror ) 
     122         IF( ierror > 0 ) THEN 
     123            CALL ctl_stop( 'asm_wri_bkg: unable to allocate ssh_tavg' )   ;   RETURN 
     124         ENDIF 
     125         ssh_tavg=0 
     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         ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror ) 
     132         IF( ierror > 0 ) THEN 
     133            CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' )   ;   RETURN 
     134         ENDIF 
     135         avt_tavg=0 
     136         gcx_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         gcx_tavg              = gcx_tavg       + gcx / numtimes_tavg 
     154         avt_tavg(:,:,:)        = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg 
     155#if defined key_zdftke 
     156         en_tavg(:,:,:)       = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 
     157#endif 
     158      ENDIF 
     159      
     160 
     161      ! Write out background at time step nitbkg_r or nitavgbkg_r 
     162      IF( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. & 
     163      &       ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) THEN 
    88164         ! 
    89165         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) 
     
    109185            ENDIF 
    110186            ! 
    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             CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               ) 
    123             ! 
     187            ! Write the information 
     188            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   ) 
     189             
     190            IF ( ln_avgbkg ) THEN 
     191               CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un_tavg ) 
     192               CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn_tavg ) 
     193               CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn_tavg ) 
     194               CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn_tavg ) 
     195               CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    ) 
     196#if defined key_zdftke 
     197               CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en_tavg ) 
     198#endif 
     199               CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx_tavg) 
     200               CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt_tavg) 
     201               ! 
     202            ELSE 
     203               CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                ) 
     204               CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                ) 
     205               CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     206               CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     207               CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
     208#if defined key_zdftke 
     209               CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
     210#endif 
     211               CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
     212               CALL iom_rstput( kt, nitbkg_r, inum, 'avt'    , avt               ) 
     213               ! 
     214            ENDIF 
     215             
    124216            CALL iom_close( inum ) 
     217 
    125218         ENDIF 
    126219         ! 
  • branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r6761 r6762  
    6969#endif 
    7070   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 
    7172   LOGICAL, PUBLIC :: ln_asmiau = .FALSE.      !: No applying forcing with an assimilation increment 
    7273   LOGICAL, PUBLIC :: ln_asmdin = .FALSE.      !: No direct initialization 
     
    9293   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
    9394   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] 
    9496   !  
    9597   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
     
    139141      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    140142      INTEGER :: isurfstat       ! Local integer for status of reading surft variable 
     143      INTEGER :: iitavgbkg_date  ! Date YYYYMMDD of end of assim bkg averaging period 
    141144      ! 
    142145      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
     
    158161                               !               so only apply surft increments. 
    159162      !! 
    160       NAMELIST/nam_asminc/ ln_bkgwri,                                      & 
     163      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg                            & 
    161164         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
    162165         &                 ln_asmdin, ln_asmiau,                           & 
    163166         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    164          &                 ln_salfix, salfixmin, nn_divdmp, mld_choice 
     167         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice 
    165168      !!---------------------------------------------------------------------- 
    166169 
     
    171174      ! Set default values 
    172175      ln_bkgwri = .FALSE. 
     176      ln_avgbkg = .FALSE. 
    173177      ln_trainc = .FALSE. 
    174178      ln_dyninc = .FALSE. 
     
    185189      nitiaufin = 150 
    186190      niaufn    = 0 
     191      nitavgbkg = 1 
    187192 
    188193      REWIND( numnam_ref )              ! Namelist nam_asminc in reference namelist : Assimilation increment 
     
    202207         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
    203208         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 
    204210         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
    205211         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     
    212218         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 
    213219         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 
    214221         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
    215222         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
     
    222229      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000 
    223230      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000 
     231      nitavgbkg_r = nitavgbkg + nit000 - 1  ! Averaging period referenced to nit000 
    224232 
    225233      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length 
     
    231239      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    232240      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 
    233242      ! 
    234243      IF(lwp) THEN 
     
    242251         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r 
    243252         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r 
     253         WRITE(numout,*) '       nitavgbkg_r = ', nitavgbkg_r 
    244254         WRITE(numout,*) 
    245255         WRITE(numout,*) '   Dates referenced to current cycle:' 
     
    251261         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    252262         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     263         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date 
    253264      ENDIF 
    254265 
     
    293304         & CALL ctl_stop( ' nitdin :',  & 
    294305         &                ' 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', & 
    295311         &                ' the cycle interval') 
    296312 
Note: See TracChangeset for help on using the changeset viewer.