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.
step_c1d.F90 in NEMO/branches/UKMO/NEMO_4.0_FKOSM/src/OCE/C1D – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_FKOSM/src/OCE/C1D/step_c1d.F90 @ 12516

Last change on this file since 12516 was 12516, checked in by cguiavarch, 4 years ago

add modernised diahth w/o key

File size: 8.6 KB
Line 
1MODULE step_c1d
2   !!======================================================================
3   !!                       ***  MODULE step_c1d  ***
4   !! Time-stepping    : manager of the ocean, tracer and ice time stepping - c1d case
5   !!======================================================================
6   !! History :   2.0  !  2004-04  (C. Ethe)  adapted from step.F90 for C1D
7   !!             3.0  !  2008-04  (G. Madec)  redo the adaptation to include SBC
8   !!----------------------------------------------------------------------
9#if defined key_c1d
10   !!----------------------------------------------------------------------
11   !!   'key_c1d'                                       1D Configuration
12   !!---------------------------------------------------------------------- 
13   !!   stp_c1d        : NEMO system time-stepping in c1d case
14   !!----------------------------------------------------------------------
15   USE step_oce        ! time stepping definition modules
16#if defined key_top
17   USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
18#endif
19   USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
20   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
21   USE dyndmp          ! U & V momentum damping           (dyn_dmp routine)
22   USE restart         ! restart
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC stp_c1d      ! called by opa.F90
28
29   !!----------------------------------------------------------------------
30   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
31   !! $Id$
32   !! Software governed by the CeCILL license (see ./LICENSE)
33   !!----------------------------------------------------------------------
34CONTAINS
35
36   SUBROUTINE stp_c1d( kstp )
37      !!----------------------------------------------------------------------
38      !!                     ***  ROUTINE stp_c1d  ***
39      !!                     
40      !! ** Purpose :  - Time stepping of SBC including sea ice (dynamic and thermodynamic eqs.)
41      !!               - Time stepping of OPA (momentum and active tracer eqs.)
42      !!               - Time stepping of TOP (passive tracer eqs.)
43      !!
44      !! ** Method  : -1- Update forcings and data 
45      !!              -2- Update vertical ocean physics
46      !!              -3- Compute the t and s trends
47      !!              -4- Update t and s
48      !!              -5- Compute the momentum trends
49      !!              -6- Update the horizontal velocity
50      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
51      !!              -8- Outputs and diagnostics
52      !!----------------------------------------------------------------------
53      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
54      !
55      INTEGER ::   jk       ! dummy loop indice
56      INTEGER ::   indic    ! error indicator if < 0
57      !! ---------------------------------------------------------------------
58
59                             indic = 0                ! reset to no error condition
60                             IF( kstp == nit000 )   THEN
61                                CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
62                                CALL dia_hth_init    ! extra ML depth diagnostics, thermocline depths
63                             END IF
64      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
65                             CALL iom_setkt( kstp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp
66
67      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
68      ! Update data, open boundaries, surface boundary condition (including sea-ice)
69      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
70                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
71
72      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
73      ! Ocean physics update                (ua, va, ta, sa used as workspace)
74      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
75                         CALL eos_rab( tsb, rab_b )   ! before local thermal/haline expension ratio at T-points
76                         CALL eos_rab( tsn, rab_n )   ! now    local thermal/haline expension ratio at T-points
77                         CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency
78                         CALL bn2( tsn, rab_n, rn2  ) ! now    Brunt-Vaisala frequency
79     
80      !  VERTICAL PHYSICS
81                         CALL zdf_phy( kstp )         ! vertical physics update (bfr, avt, avs, avm + MLD)
82
83      IF(.NOT.ln_linssh )   CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_hor)
84      IF(.NOT.ln_linssh )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors
85
86      IF(.NOT.ln_linssh )   CALL wzv           ( kstp )  ! now cross-level velocity
87      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
88      ! diagnostics and outputs             (ua, va, ta, sa used as workspace)
89      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
90                         CALL dia_wri( kstp )       ! ocean model: outputs
91      IF( ll_diahth  )   CALL dia_hth( kstp )       ! Thermocline depth (20°C)
92
93
94#if defined key_top
95      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
96      ! Passive Tracer Model
97      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
98                        CALL trc_stp( kstp )       ! time-stepping
99#endif
100
101      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
102      ! Active tracers                              (ua, va used as workspace)
103      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
104                        tsa(:,:,:,:) = 0._wp       ! set tracer trends to zero
105
106                        CALL tra_sbc( kstp )       ! surface boundary condition
107      IF( ln_traqsr )   CALL tra_qsr( kstp )       ! penetrative solar radiation qsr
108      IF( ln_tradmp )   CALL tra_dmp( kstp )       ! internal damping trends- tracers
109      IF(.NOT.ln_linssh)CALL tra_adv( kstp )       ! horizontal & vertical advection
110      IF( ln_zdfosm  )  CALL tra_osm( kstp )       ! OSMOSIS non-local tracer fluxes
111                        CALL tra_zdf( kstp )       ! vertical mixing
112                        CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) )   ! now potential density for zdfmxl
113      IF( ln_zdfnpc )   CALL tra_npc( kstp )       ! applied non penetrative convective adjustment on (t,s)
114                        CALL tra_nxt( kstp )       ! tracer fields at next time step
115
116
117
118      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
119      ! Dynamics                                    (ta, sa used as workspace)
120      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
121                        ua(:,:,:) = 0._wp          ! set dynamics trends to zero
122                        va(:,:,:) = 0._wp
123
124      IF( ln_dyndmp )   CALL dyn_dmp    ( kstp )   ! internal damping trends- momentum
125                        CALL dyn_cor_c1d( kstp )   ! vorticity term including Coriolis
126      IF( ln_zdfosm  )  CALL dyn_osm    ( kstp )   ! OSMOSIS non-local velocity fluxes
127                        CALL dyn_zdf    ( kstp )   ! vertical diffusion
128                        CALL dyn_nxt    ( kstp )   ! lateral velocity at next time step
129      IF(.NOT.ln_linssh)CALL ssh_swp    ( kstp )   ! swap of sea surface height
130
131      IF(.NOT.ln_linssh)CALL dom_vvl_sf_swp( kstp )! swap of vertical scale factors
132
133      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
134      ! Control and restarts
135      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
136                             CALL stp_ctl( kstp, indic )
137      IF( kstp == nit000 )   CALL iom_close( numror )      ! close input  ocean restart file
138      IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file
139      !
140#if defined key_iomput
141      IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS
142      !
143#endif
144   END SUBROUTINE stp_c1d
145
146#else
147   !!----------------------------------------------------------------------
148   !!   Default key                                            NO 1D Config
149   !!----------------------------------------------------------------------
150CONTAINS
151   SUBROUTINE stp_c1d ( kt )      ! dummy routine
152      IMPLICIT NONE
153      INTEGER, INTENT( in ) :: kt
154      WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kt
155   END SUBROUTINE stp_c1d
156#endif
157
158   !!======================================================================
159END MODULE step_c1d
Note: See TracBrowser for help on using the repository browser.