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 5676 for branches/2015 – NEMO

Changeset 5676 for branches/2015


Ignore:
Timestamp:
2015-08-10T17:39:59+02:00 (9 years ago)
Author:
jwhile
Message:

Adding cool skin and warm layer + associated modifications

Location:
branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM
Files:
4 added
8 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/CONFIG/SHARED/field_def.xml

    r5517 r5676  
    3636         <field id="sstgrad2"     long_name="square of module of sst gradient"                                                        unit="degC2/m2" /> 
    3737         <field id="sbt"          long_name="sea bottom temperature"                                                                  unit="degC"     /> 
    38      
     38         <field id="sst_wl"       long_name="Delta SST of warm layer"                                                                 unit="degC"     /> 
     39         <field id="sst_cs"       long_name="Delta SST of cool skin"                                                                  unit="degC"     /> 
     40    <field id="temp_3m"      long_name="temperature at 3m"                                                                       unit="degC"     /> 
     41          
    3942         <field id="sss"          long_name="sea surface salinity"             standard_name="sea_surface_salinity"   unit="1e-3" /> 
    4043         <field id="sss2"         long_name="square of sea surface salinity"                                          unit="1e-6"  > sss * sss </field > 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5656 r5676  
    12931293   rn_htrmax         =  200.0   ! max. depth of transition range 
    12941294/ 
     1295!----------------------------------------------------------------------- 
     1296&namdiu !   Cool skin and warm layer modesl 
     1297!----------------------------------------------------------------------- 
     1298   ln_diurnal = .false. 
     1299   ln_diurnal_only = .false. 
     1300/ 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5566 r5676  
    5555   USE lib_mpp         ! MPP library 
    5656   USE timing          ! preformance summary 
     57   USE diurnal_bulk    ! diurnal warm layer 
     58   USE cool_skin       ! Cool skin 
    5759   USE wrk_nemo        ! working array 
    5860 
     
    145147      ENDIF 
    146148 
     149      IF(ln_diurnal) THEN 
     150         CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer 
     151         CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin 
     152      ENDIF 
     153        
     154      IF( ln_diurnal_only ) RETURN  
     155       
    147156      IF( .NOT.lk_vvl ) THEN 
    148157         CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5407 r5676  
    2424   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    26  
     26   USE diurnal_bulk 
     27    
    2728   IMPLICIT NONE 
    2829   PRIVATE 
     
    125126                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step 
    126127                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step 
    127  
     128      IF ( .NOT. ln_diurnal_only ) THEN 
    128129                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields 
    129130                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        ) 
     
    145146                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    146147#endif 
     148      ENDIF 
     149       
     150      IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst    )   
     151       
    147152      IF( kt == nitrst ) THEN 
    148153         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     
    221226         IF( zrdttra1 /= rdttra(1) )   neuler = 0 
    222227      ENDIF 
    223       !  
     228        
     229       
     230      ! Diurnal DSST  
     231      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  )  
     232      IF ( ln_diurnal_only ) THEN  
     233         IF(lwp) WRITE( numout, * ) & 
     234         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0"  
     235         rhop = rau0 
     236         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) )  
     237         RETURN  
     238      ENDIF   
     239       
    224240      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    225241         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5643 r5676  
    5555   USE bdy_par          ! Require lk_bdy 
    5656 
     57   USE diurnal_bulk, ONLY: & 
     58      & ln_diurnal_only  
     59 
    5760   IMPLICIT NONE 
    5861   PRIVATE 
     
    404407      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
    405408 
    406       IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain  
    407       !                                                           ! (update freshwater fluxes) 
     409      ! treatment of closed sea in the model domain  
     410      ! (update freshwater fluxes) 
     411      ! Should not be ran if ln_diurnal_only 
     412      IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt )    
     413 
    408414!RBbug do not understand why see ticket 667 
    409415!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5656 r5676  
    7676#endif 
    7777   USE lib_mpp         ! distributed memory computing 
     78   USE diurnal_bulk    ! diurnal bulk SST  
    7879#if defined key_iomput 
    7980   USE xios 
     
    169170            CALL stp                         ! AGRIF: time stepping 
    170171#else 
    171             CALL stp( istp )                 ! standard time stepping 
     172            IF ( .NOT. ln_diurnal_only ) THEN  
     173               CALL stp( istp )                 ! standard time stepping  
     174            ELSE  
     175               CALL stp_diurnal( istp )        ! time step only the diurnal SST  
     176            ENDIF  
    172177#endif 
    173178            istp = istp + 1 
     
    400405 
    401406      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    402  
     407       
     408      CALL diurnal_sst_bulk_init            ! diurnal sst 
     409      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin    
     410       
     411      ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 
     412      IF ( ln_diurnal_only ) THEN 
     413         CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     414         CALL     sbc_init   ! Forcings : surface module 
     415         CALL tra_qsr_init   ! penetrative solar radiation qsr 
     416         IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
     417            CALL dia_obs_init            ! Initialize observational data 
     418            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
     419         ENDIF      
     420         !                                     ! Assimilation increments 
     421         IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
     422                  
     423         IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     424         RETURN 
     425      ENDIF 
     426       
    403427                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    404428 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5656 r5676  
    3737   PRIVATE 
    3838 
    39    PUBLIC   stp   ! called by opa.F90 
     39   PUBLIC   stp, stp_diurnal   ! called by opa.F90 
    4040 
    4141   !! * Substitutions 
     
    227227 
    228228      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     229      ! cool skin 
     230      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     231      IF ( ln_diurnal ) THEN  
     232         IF ( .NOT. ln_blk_core ) THEN 
     233            CALL ctl_stop("step.f90: diurnal flux processing not implemented"//& 
     234            &             " for direct forcing") 
     235         ENDIF 
     236         CALL diurnal_sst_coolskin_step( &  
     237                    qns, taum, rhop(:,:,1), rdt) 
     238      ENDIF 
     239       
     240      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    229241      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    230242      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     
    238250      ! 
    239251      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    240  
     252       
     253      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     254      ! diurnal warm layer 
     255      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     256      IF ( ln_diurnal ) THEN  
     257         IF( kstp == nit000 )THEN  
     258            CALL diurnal_sst_takaya_step( &  
     259            &    qsr, qns, taum, rhop(:,:,1), & 
     260            &    rdt, ld_calcfrac = .TRUE.)  
     261         ELSE  
     262            CALL diurnal_sst_takaya_step( &  
     263            &    qsr, qns, taum, rhop(:,:,1), rdt )  
     264         ENDIF 
     265      ENDIF      
     266       
     267       
    241268#if defined key_top 
    242269      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    386413      ! 
    387414   END SUBROUTINE stp 
    388  
     415    
     416   SUBROUTINE stp_diurnal( kstp )  
     417      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index  
     418      !!----------------------------------------------------------------------  
     419      !!                     ***  ROUTINE stp  ***  
     420      !!                        
     421      !! ** Purpose : - Time stepping of diurnal SST model only  
     422      !!    
     423      !! ** Method  : -1- Update forcings and data    
     424      !!              -2- Update ocean physics    
     425      !!              -3- Compute the t and s trends    
     426      !!              -4- Update t and s    
     427      !!              -5- Compute the momentum trends  
     428      !!              -6- Update the horizontal velocity  
     429      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)  
     430      !!              -8- Outputs and diagnostics  
     431      !!----------------------------------------------------------------------  
     432      INTEGER ::   jk       ! dummy loop indices 
     433      INTEGER ::   indic    ! error indicator if < 0  
     434      REAL(wp), DIMENSION(jpi,jpj) :: z_fvel_bkginc, z_hflux_bkginc      
     435      !! ---------------------------------------------------------------------  
     436  
     437      indic = 1                                 ! reset to no error condition  
     438  
     439      IF( kstp /= nit000 )   CALL day( kstp )   ! Calendar (day was already called at nit000 in day_init)  
     440  
     441      CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
     442      IF( ln_crs ) THEN 
     443         CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp 
     444      ENDIF 
     445        
     446      CALL sbc    ( kstp )                      ! Sea Boundary Conditions  
     447      
     448      ! Cool skin 
     449      IF ( .NOT.ln_diurnal ) CALL ctl_stop(  "stp_diurnal: ln_diurnal not set"  ) 
     450          
     451      IF ( .NOT. ln_blk_core ) THEN 
     452         CALL ctl_stop("step.f90: diurnal flux processing not implemented"//& 
     453         &             " for direct forcing")  
     454      ENDIF 
     455 
     456      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt) 
     457 
     458      CALL dia_wri( kstp )                            ! ocean model: outputs  
     459        
     460      ! Diurnal warm layer model        
     461            
     462      IF( kstp == nit000 )THEN  
     463         CALL diurnal_sst_takaya_step( &  
     464         &    qsr, qns, taum, rhop(:,:,1), & 
     465         &    rdt, ld_calcfrac = .TRUE.)  
     466      ELSE  
     467         CALL diurnal_sst_takaya_step( &  
     468         &    qsr, qns, taum, rhop(:,:,1), rdt )  
     469      ENDIF 
     470 
     471      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     472      
     473      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
     474      ! Control and restarts  
     475      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
     476      IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file  
     477      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
     478      
     479      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset  
     480        
     481   END SUBROUTINE stp_diurnal   
     482    
    389483   !!====================================================================== 
    390484END MODULE step 
  • branches/2015/dev_r5656_Met_Office_3_diurnalSST/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5656 r5676  
    8585   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine) 
    8686 
     87   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
     88   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine)    
     89   USE sbc_oce         ! surface fluxes   
     90    
    8791   USE zpshde           ! partial step: hor. derivative     (zps_hde routine) 
    8892 
Note: See TracChangeset for help on using the changeset viewer.