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 2392 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 – NEMO

Ignore:
Timestamp:
2010-11-15T22:20:05+01:00 (13 years ago)
Author:
gm
Message:

v3.3beta: Cross Land Advection (ticket #127) full rewriting + MPP bug corrections

File:
1 edited

Legend:

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

    r2287 r2392  
    55   !!                          assimilation 
    66   !!====================================================================== 
     7   !! History :       ! 2007-03  (M. Martin)  Met Office version 
     8   !!                 ! 2007-04  (A. Weaver)  calc_date original code 
     9   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR 
     10   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2 
     11   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
     12   !!---------------------------------------------------------------------- 
    713 
    814   !!---------------------------------------------------------------------- 
     
    1521   !!   ssh_asm_inc  : Apply the SSH increment 
    1622   !!---------------------------------------------------------------------- 
    17    !! * Modules used    
    18    USE par_kind, ONLY : &       ! Precision variables 
    19       & wp 
    20    USE in_out_manager, ONLY : & ! I/O manager  
    21       & lwp,      & 
    22       & numnam,   & 
    23       & numout,   & 
    24       & ctl_warn, & 
    25       & ctl_stop, & 
    26       & nit000,   & 
    27       & nstop,    & 
    28       & ln_rstart 
    29    USE par_oce, ONLY : & ! Ocean space and time domain variables 
    30       & jpi,  &  
    31       & jpj,  & 
    32       & jpk,  & 
    33       & jpkm1 
    34    USE dom_oce, ONLY : & ! Ocean space and time domain 
    35       & rdt,    & 
    36       & n_cla,  & 
    37       & neuler, & 
    38       & ln_zps, & 
    39       & tmask,  & 
    40       & umask,  & 
    41       & vmask 
     23   USE in_out_manager   ! I/O manager 
     24   USE par_oce          ! Ocean space and time domain variables 
     25   USE dom_oce          ! Ocean space and time domain 
     26   USE oce              ! Dynamics and active tracers defined in memory 
     27   USE divcur           ! Horizontal divergence and relative vorticity 
     28   USE eosbn2           ! Equation of state - in situ and potential density 
     29   USE zpshde           ! Partial step : Horizontal Derivative 
     30   USE iom              ! Library to read input files 
     31   USE asmpar           ! Parameters for the assmilation interface 
    4232#if defined key_c1d 
    43    USE c1d, ONLY : &    ! 1D initialization 
    44       & lk_c1d 
     33   USE c1d, ONLY :   lk_c1d    ! 1D initialization 
    4534#endif 
    46    USE oce, ONLY : &      ! Dynamics and active tracers defined in memory 
    47       & ub, un, ua,    & 
    48       & vb, vn, va,    & 
    49       & tsb, tsn, tsa, & 
    50       & sshb, sshn,    & 
    51       & rhd, rhop,     & 
    52       & rotb, rotn,    & 
    53       & hdivb, hdivn,  & 
    54       & gtsu, gru,     & 
    55       & gtsv, grv  
    56    USE divcur, ONLY : &   ! Horizontal divergence and relative vorticity 
    57       & div_cur 
    58    USE cla_div, ONLY : &  ! Specific update of the horizontal divergence 
    59       & div_cla           ! (specific to ORCA_R2) 
    60    USE eosbn2, ONLY : &   ! Equation of state - in situ and potential density 
    61       & eos 
    62    USE zpshde, ONLY : &   ! Partial step : Horizontal Derivative 
    63       & zps_hde 
    64 !   USE phycst, ONLY : &   ! Calendar parameters 
    65 !      & rjjss   
    66    USE iom                ! Library to read input files 
    67    USE asmpar             ! Parameters for the assmilation interface 
    68    USE dom_oce, ONLY : & 
    69       & ndastp 
    70 !   USE daymod, ONLY : & 
    71 !      & nmonth_len         ! length of month in days 
    72 !      & nbiss, & 
    73 !      & nobis, & 
    74   
    7535 
    7636   IMPLICIT NONE 
    77  
    78    !! * Routine accessibility 
    7937   PRIVATE 
    80    PUBLIC asm_inc_init, & !: Initialize the increment arrays and IAU weights 
    81       &   calc_date,    & !: Compute the calendar date YYYYMMDD on a given step 
    82       &   tra_asm_inc,  & !: Apply the tracer (T and S) increments 
    83       &   dyn_asm_inc,  & !: Apply the dynamic (u and v) increments 
    84       &   ssh_asm_inc     !: Apply the SSH increment 
    85  
    86    !! * Private Module variables 
    87    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: & 
    88       & t_bkg,    &       !: Background temperature  
    89       & s_bkg,    &       !: Background salinity 
    90       & u_bkg,    &       !: Background u-component velocity 
    91       & v_bkg,    &       !: Background v-component velocity 
    92       & t_bkginc, &       !: Increment to the background temperature 
    93       & s_bkginc, &       !: Increment to the background salinity 
    94       & u_bkginc, &       !: Increment to the u-component velocity  
    95       & v_bkginc          !: Increment to the v-component velocity  
    96           
    97    REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: & 
    98       & ssh_bkg,   &      !: Background sea surface height 
    99       & ssh_bkginc        !: Increment to the background sea surface height 
    100  
    101    REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
    102       & wgtiau            !: IAU weights for each time step 
    103  
    104    !! * Shared Module variables 
    105    LOGICAL, PUBLIC, PARAMETER :: & 
     38    
     39   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
     40   PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step 
     41   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
     42   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
     43   PUBLIC   ssh_asm_inc    !: Apply the SSH increment 
     44 
    10645#if defined key_asminc 
    107       & lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface 
     46    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface 
    10847#else 
    109       & lk_asminc = .FALSE.  !: No assimilation increments 
     48    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments 
    11049#endif 
    111  
    11250   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 
    11351   LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields 
     
    11957   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 
    12058 
    121    REAL, PUBLIC :: salfixmin   !: Ensure that the salinity is larger than  
    122    !                           !: this  value if (ln_salfix) 
     59   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity 
     60   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkg   , v_bkg      !: Background u- & v- velocity components 
     61   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkginc, s_bkginc   !: Increment to the background T & S 
     62   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components  
     63   REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step 
    12364#if defined key_asminc 
    124    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & 
    125       & ssh_iau           !: IAU-weighted sea surface height increment 
     65   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_iau           !: IAU-weighted sea surface height increment 
    12666#endif 
    127  
    128    INTEGER, PUBLIC :: nitbkg     !: Time step of the background state used in the Jb term 
    129                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    130    INTEGER, PUBLIC :: nitdin     !: Time step of the background state for direct initialization 
    131                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    132    INTEGER, PUBLIC :: nitiaustr  !: Time step of the start of the IAU interval  
    133                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    134    INTEGER, PUBLIC :: nitiaufin  !: Time step of the end of the IAU interval  
    135                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    136    INTEGER, PUBLIC :: niaufn     !: Type of IAU weighing function 
    137                                  !:   0 = Constant weighting 
    138                                  !:   1 = Linear hat-like, centred in middle of IAU interval  
     67   !                                !!! time steps relative to the cycle interval [0,nitend-nit000-1] 
     68   INTEGER , PUBLIC ::   nitbkg      !: Time step of the background state used in the Jb term 
     69   INTEGER , PUBLIC ::   nitdin      !: Time step of the background state for direct initialization 
     70   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
     71   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
     72   !  
     73   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
     74   !                                 !: = 1   Linear hat-like, centred in middle of IAU interval  
     75   REAL(wp), PUBLIC ::   salfixmin   !: Ensure that the salinity is larger than this  value if (ln_salfix) 
     76 
     77   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment 
    13978 
    14079   !!---------------------------------------------------------------------- 
    14180   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    14281   !! $Id$ 
    143    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     82   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    14483   !!---------------------------------------------------------------------- 
    145  
    14684CONTAINS 
    14785 
     
    15593      !! 
    15694      !! ** Action  :  
    157       !! 
    158       !! History : 
    159       !!        !  07-03  (M. Martin) Met Office version 
    160       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    161       !!---------------------------------------------------------------------- 
    162  
    163       IMPLICIT NONE 
    164  
    165       !! * Modules used 
    166       NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, & 
    167          &                 ln_trainc, ln_dyninc, ln_sshinc, & 
    168          &                 ln_asmdin, ln_asmiau, & 
    169          &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 
    170          &                 nittrjfrq, ln_salfix, salfixmin 
    171  
    172       !! * Local declarations 
     95      !!---------------------------------------------------------------------- 
    17396      INTEGER :: jt 
    174  
    17597      INTEGER :: imid 
    17698      INTEGER :: inum 
     
    190112      REAL(wp) :: zdate_bkg    ! Date in background state file for DI 
    191113      REAL(wp) :: zdate_inc    ! Time axis in increments file 
     114      !! 
     115      NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri,                           & 
     116         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
     117         &                 ln_asmdin, ln_asmiau,                           & 
     118         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
     119         &                 nittrjfrq, ln_salfix, salfixmin 
     120      !!---------------------------------------------------------------------- 
    192121 
    193122      !----------------------------------------------------------------------- 
     
    220149         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 
    221150         WRITE(numout,*) '~~~~~~~~~~~~' 
    222          WRITE(numout,*) '          Namelist namasm : set assimilation increment parameters' 
    223          WRITE(numout,*) '             Logical switch for writing out background state         ', & 
    224             &            ' ln_bkgwri = ', ln_bkgwri 
    225          WRITE(numout,*) '             Logical switch for writing out state trajectory         ', & 
    226             &            ' ln_trjwri = ', ln_trjwri 
    227          WRITE(numout,*) '             Logical switch for applying tracer increments           ', & 
    228             &            ' ln_trainc = ', ln_trainc 
    229          WRITE(numout,*) '             Logical switch for applying velocity increments         ', & 
    230             &            ' ln_dyninc = ', ln_dyninc 
    231          WRITE(numout,*) '             Logical switch for applying SSH increments              ', & 
    232             &            ' ln_sshinc = ', ln_sshinc 
    233          WRITE(numout,*) '             Logical switch for Direct Initialization (DI)           ', & 
    234             &            ' ln_asmdin = ', ln_asmdin 
    235          WRITE(numout,*) '             Logical switch for Incremental Analysis Updating (IAU)  ', & 
    236             &            ' ln_asmiau = ', ln_asmiau 
    237          WRITE(numout,*) '             Timestep of background in [0,nitend-nit000-1]           ', & 
    238             &            '    nitbkg = ', nitbkg 
    239          WRITE(numout,*) '             Timestep of background for DI in [0,nitend-nit000-1]    ', & 
    240             &            '    nitdin = ', nitdin 
    241          WRITE(numout,*) '             Timestep of start of IAU interval in [0,nitend-nit000-1]', & 
    242             &            ' nitiaustr = ', nitiaustr 
    243          WRITE(numout,*) '             Timestep of end of IAU interval in [0,nitend-nit000-1]  ', & 
    244             &            ' nitiaufin = ', nitiaufin 
    245          WRITE(numout,*) '             Type of IAU weighting function                          ', & 
    246             &            '    niaufn = ', niaufn 
    247          WRITE(numout,*) '             Frequency of trajectory output for 4D-VAR               ', & 
    248             &            ' nittrjfrq = ', nittrjfrq 
    249          WRITE(numout,*) '             Logical switch for ensuring that the sa > salfixmin     ', & 
    250             &            ' ln_salfix = ', ln_salfix 
    251          WRITE(numout,*) '             Minimum salinity after applying the increments          ', & 
    252             &            ' salfixmin = ', salfixmin 
     151         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
     152         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
     153         WRITE(numout,*) '      Logical switch for writing out state trajectory          ln_trjwri = ', ln_trjwri 
     154         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
     155         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     156         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc 
     157         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin 
     158         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau 
     159         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg 
     160         WRITE(numout,*) '      Timestep of background for DI in [0,nitend-nit000-1]     nitdin    = ', nitdin 
     161         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 
     162         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin 
     163         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
     164         WRITE(numout,*) '      Frequency of trajectory output for 4D-VAR                nittrjfrq = ', nittrjfrq 
     165         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
     166         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin 
    253167      ENDIF 
    254168 
     
    565479 
    566480      ENDIF 
    567  
     481      ! 
    568482   END SUBROUTINE asm_inc_init 
     483 
    569484 
    570485   SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) 
     
    577492      !! 
    578493      !! ** Action  :  
    579       !! 
    580       !! History : 
    581       !!        !  07-04  (A. Weaver)  
    582       !!        !  10-05  (D. Lea)        Update to work with NEMO vn3.2 
    583       !!---------------------------------------------------------------------- 
    584  
    585       IMPLICIT NONE 
    586  
    587       !! * Arguments 
    588  
     494      !!---------------------------------------------------------------------- 
    589495      INTEGER, INTENT(IN) :: kit000  ! Initial time step 
    590496      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000 
    591497      INTEGER, INTENT(IN) :: kdate0  ! Initial date 
    592498      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0 
    593  
    594       !! * Local declarations 
    595  
     499      ! 
    596500      INTEGER :: iyea0    ! Initial year 
    597501      INTEGER :: imon0    ! Initial month 
     
    648552         idaycnt = idaycnt + 1 
    649553      END DO 
    650  
     554      ! 
    651555      kdate = iyea * 10000 + imon * 100 + iday 
    652  
     556      ! 
    653557   END SUBROUTINE 
     558 
    654559 
    655560   SUBROUTINE calc_month_len( iyear, imonth_len ) 
     
    660565      !! 
    661566      !! ** Method  :  
    662       !! 
    663       !! ** Action  :  
    664       !! 
    665       !! History : 
    666       !!        !  10-05  (D. Lea)   New routine based on day_init  
    667       !!---------------------------------------------------------------------- 
    668  
     567      !!---------------------------------------------------------------------- 
    669568      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    670569      INTEGER :: iyear         !: year 
    671  
     570      !!---------------------------------------------------------------------- 
     571      ! 
    672572      ! length of the month of the current year (from nleapy, read in namelist) 
    673573      IF ( nleapy < 2 ) THEN  
     
    681581         imonth_len(:) = nleapy   ! all months with nleapy days per year 
    682582      ENDIF 
    683  
     583      ! 
    684584   END SUBROUTINE 
     585 
    685586 
    686587   SUBROUTINE tra_asm_inc( kt ) 
     
    693594      !! 
    694595      !! ** Action  :  
    695       !! 
    696       !! History : 
    697       !!        !  07-03  (M. Martin) Met Office version 
    698       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    699       !!---------------------------------------------------------------------- 
    700  
    701       IMPLICIT NONE 
    702  
    703       !! * Arguments 
     596      !!---------------------------------------------------------------------- 
    704597      INTEGER, INTENT(IN) :: kt               ! Current time step 
    705  
    706       !! * Local declarations 
     598      ! 
    707599      INTEGER :: ji,jj,jk 
    708600      INTEGER :: it 
    709601      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     602      !!---------------------------------------------------------------------- 
    710603 
    711604      IF ( ln_asmiau ) THEN 
     
    793686            DEALLOCATE( s_bkg    ) 
    794687         ENDIF 
    795           
    796       ENDIF 
    797  
     688          
     689      ENDIF 
     690      ! 
    798691   END SUBROUTINE tra_asm_inc 
     692 
    799693 
    800694   SUBROUTINE dyn_asm_inc( kt ) 
     
    807701      !! 
    808702      !! ** Action  :  
    809       !! 
    810       !! History : 
    811       !!        !  07-03  (M. Martin) Met Office version 
    812       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    813       !!---------------------------------------------------------------------- 
    814  
    815       IMPLICIT NONE 
    816  
    817       !! * Arguments 
     703      !!---------------------------------------------------------------------- 
    818704      INTEGER, INTENT(IN) :: kt   ! Current time step 
    819  
    820       !! * Local declarations 
     705      ! 
    821706      INTEGER :: jk 
    822707      INTEGER :: it 
    823708      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     709      !!---------------------------------------------------------------------- 
    824710 
    825711      IF ( ln_asmiau ) THEN 
     
    871757            vb(:,:,:) = vn(:,:,:) 
    872758  
    873             CALL div_cur( kt )                  ! Compute divergence and curl for now fields 
    874             IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 
     759            CALL div_cur( kt )            ! Compute divergence and curl for now fields 
    875760 
    876761            rotb (:,:,:) = rotn (:,:,:)   ! Update before fields 
     
    881766            DEALLOCATE( u_bkginc ) 
    882767            DEALLOCATE( v_bkginc ) 
    883  
    884          ENDIF 
    885  
    886       ENDIF 
    887  
     768         ENDIF 
     769         ! 
     770      ENDIF 
     771      ! 
    888772   END SUBROUTINE dyn_asm_inc 
     773 
    889774 
    890775   SUBROUTINE ssh_asm_inc( kt ) 
     
    897782      !! 
    898783      !! ** Action  :  
    899       !! 
    900       !! History : 
    901       !!        !  07-03  (M. Martin) Met Office version 
    902       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    903       !!---------------------------------------------------------------------- 
    904  
    905       IMPLICIT NONE 
    906  
    907       !! * Arguments 
     784      !!---------------------------------------------------------------------- 
    908785      INTEGER, INTENT(IN) :: kt   ! Current time step 
    909  
    910       !! * Local declarations 
     786      ! 
    911787      INTEGER :: it 
    912788      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     789      !!---------------------------------------------------------------------- 
    913790 
    914791      IF ( ln_asmiau ) THEN 
     
    960837 
    961838         ENDIF 
    962  
    963       ENDIF 
    964  
     839         ! 
     840      ENDIF 
     841      ! 
    965842   END SUBROUTINE ssh_asm_inc 
    966843 
     844   !!====================================================================== 
    967845END MODULE asminc 
Note: See TracChangeset for help on using the changeset viewer.