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 5407 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 – NEMO

Ignore:
Timestamp:
2015-06-11T21:13:22+02:00 (9 years ago)
Author:
smasson
Message:

merge dev_r5218_CNRS17_coupling into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5385 r5407  
    3939   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    4040   USE sbccpl           ! surface boundary condition: coupled florulation 
     41   USE cpl_oasis3       ! OASIS routines for coupling 
    4142   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4243   USE sbcrnf           ! surface boundary condition: runoffs 
     
    8485      INTEGER ::   icpt   ! local integer 
    8586      !! 
    86       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    87          &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    88          &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
     87      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   & 
     88         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   & 
     89         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   & 
     90         &             nn_lsm    , nn_limflx , nn_components, ln_cpl 
    8991      INTEGER  ::   ios 
     92      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
     93      LOGICAL  ::   ll_purecpl 
    9094      !!---------------------------------------------------------------------- 
    9195 
     
    115119          nn_ice      =   0 
    116120      ENDIF 
    117       
     121 
    118122      IF(lwp) THEN               ! Control print 
    119123         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
     
    125129         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    126130         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    127          WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     131         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl 
     132         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl 
     133         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis 
     134         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    128135         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    129136         WRITE(numout,*) '           Misc. options of sbc : ' 
     
    152159      END SELECT 
    153160      ! 
     161      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
     162         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     163      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   & 
     164         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
     165      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
     166         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     167      IF ( ln_cpl .AND. .NOT. lk_oasis )    & 
     168         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
     169      IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
     170         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
     171      IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
     172         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
     173      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
     174         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     175 
    154176      !                              ! allocate sbc arrays 
    155177      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
     
    170192         fwfisf_b(:,:) = 0.0_wp 
    171193      END IF 
    172       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     194      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 
    173195 
    174196      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
     
    180202 
    181203      !                                            ! restartability    
    182       IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    183           MOD( nstock             , nn_fsbc) /= 0 ) THEN  
    184          WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    185             &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    186          CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
    187       ENDIF 
    188       ! 
    189       IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
    190          &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    191       ! 
    192       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     204      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
    193205         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    194       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    195          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     206      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
     207         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
    196208      IF( nn_ice == 4 .AND. lk_agrif )   & 
    197209         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
     
    200212      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
    201213         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
    202       IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     214      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
    203215         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    204       IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     216      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
    205217         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    206218 
    207219      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    208220 
    209       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
     221      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
    210222         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    211223       
    212       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    213          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    214  
    215224      IF ( ln_wave ) THEN 
    216225      !Activated wave module but neither drag nor stokes drift activated 
     
    227236      ENDIF  
    228237      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     238      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     239      ! 
    229240      icpt = 0 
    230       IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    231       IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    232       IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    233       IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    234       IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    235       IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    236       IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
    237       IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
     241      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     242      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
     243      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
     244      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
     245      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     246      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
     247      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
     248      IF( nn_components == jp_iam_opa )   & 
     249         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     250      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations 
    238251      ! 
    239252      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
     
    246259      IF(lwp) THEN 
    247260         WRITE(numout,*) 
    248          IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    249          IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
    250          IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
    251          IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
    252          IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
    253          IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
    254          IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
    255          IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
    256       ENDIF 
    257       ! 
     261         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     262         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation' 
     263         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation' 
     264         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation' 
     265         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation' 
     266         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation' 
     267         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation' 
     268         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation' 
     269         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis' 
     270         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation' 
     271         IF( nn_components/= jp_iam_nemo )  & 
     272            &                       WRITE(numout,*) '              + OASIS coupled SAS' 
     273      ENDIF 
     274      ! 
     275      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     276      !                                                     !                                            (2) the use of nn_fsbc 
     277 
     278!     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     279!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     280      IF ( nn_components /= jp_iam_nemo ) THEN 
     281 
     282         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
     283         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     284         ! 
     285         IF(lwp)THEN 
     286            WRITE(numout,*) 
     287            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     288            WRITE(numout,*) 
     289         ENDIF 
     290      ENDIF 
     291 
     292      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
     293          MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     294         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
     295            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
     296         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
     297      ENDIF 
     298      ! 
     299      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
     300         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
     301      ! 
     302      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
     303         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     304 
    258305                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    259306      ! 
     
    265312 
    266313      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    267       ! 
    268       IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
    269314       
    270315   END SUBROUTINE sbc_init 
     
    310355                                                         ! (caution called before sbc_ssm) 
    311356      ! 
    312       CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    313       !                                                  ! averaged over nf_sbc time-step 
     357      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     358      !                                                        ! averaged over nf_sbc time-step 
    314359 
    315360      IF (ln_wave) CALL sbc_wave( kt ) 
     
    322367      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    323368      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    324       CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    325       CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     369      CASE( jp_core  )    
     370         IF( nn_components == jp_iam_sas ) & 
     371            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
     372                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     373                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     374      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     375                                                                        ! 
    326376      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     377      CASE( jp_none  )  
     378         IF( nn_components == jp_iam_opa ) & 
     379                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    327380      CASE( jp_esopa )                                 
    328381                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     
    334387      END SELECT 
    335388 
     389      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     390 
     391 
    336392      !                                            !==  Misc. Options  ==! 
    337393       
     
    356412      !                                                           ! (update freshwater fluxes) 
    357413!RBbug do not understand why see ticket 667 
    358       !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 
     414!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
     415      CALL lbc_lnk( emp, 'T', 1. ) 
    359416      ! 
    360417      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
     
    397454         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    398455         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    399          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
     456         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx ) 
    400457      ENDIF 
    401458 
     
    412469         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    413470         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    414          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     471         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    415472         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
    416473         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
Note: See TracChangeset for help on using the changeset viewer.