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/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/tests/STATION_ASF/MY_SRC – NEMO

source: NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/tests/STATION_ASF/MY_SRC/step_c1d.F90 @ 11838

Last change on this file since 11838 was 11637, checked in by laurent, 4 years ago

LB: preliminary inclusion of "STATION_ASF" test-case!

File size: 5.8 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   !LB:USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
17   !LB:USE dynnxt          ! time-stepping                    (dyn_nxt routine)
18   !LB:USE dyndmp          ! U & V momentum damping           (dyn_dmp routine)
19   USE restart         ! restart
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   stp_c1d   ! called by nemogcm.F90
25
26   !!----------------------------------------------------------------------
27   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
28   !! $Id: step_c1d.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
29   !! Software governed by the CeCILL license (see ./LICENSE)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE stp_c1d( kstp )
34      !!----------------------------------------------------------------------
35      !!                     ***  ROUTINE stp_c1d  ***
36      !!                     
37      !! ** Purpose :  - Time stepping of SBC including sea ice (dynamic and thermodynamic eqs.)
38      !!               - Time stepping of OPA (momentum and active tracer eqs.)
39      !!               - Time stepping of TOP (passive tracer eqs.)
40      !!
41      !! ** Method  : -1- Update forcings and data 
42      !!              -2- Update vertical ocean physics
43      !!              -3- Compute the t and s trends
44      !!              -4- Update t and s
45      !!              -5- Compute the momentum trends
46      !!              -6- Update the horizontal velocity
47      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
48      !!              -8- Outputs and diagnostics
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
51      !
52      INTEGER ::   jk       ! dummy loop indice
53      INTEGER ::   indic    ! error indicator if < 0
54      !! ---------------------------------------------------------------------
55
56                             indic = 0                ! reset to no error condition
57      IF( kstp == nit000 )   CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
58      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
59                             CALL iom_setkt( kstp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp
60
61                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
62
63                             CALL dia_wri( kstp )         ! ocean model: outputs
64
65                             
66      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
67      ! Control
68      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
69      !LOLO:                       
70                            ! LOLO: should write a stp_ctl, who checks on flux realism (current SAS version checks ice fields...)
71                            ! CALL stp_ctl( kstp, indic )
72      !IF( indic < 0  )  THEN
73      !                       CALL ctl_stop( 'step: indic < 0' )
74      !                       CALL dia_wri_state( 'output.abort' )
75      !ENDIF
76      !LOLO.
77                             
78      IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file
79
80      !LOLO: from C1D:
81      IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file
82      !
83#if defined key_iomput
84      IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS
85#endif
86
87      !LOLO: from SAS"
88!#if defined key_iomput
89!      IF( kstp == nitrst ) THEN
90!         IF(.NOT.lwxios) THEN
91!            CALL iom_close( numrow )
92!         ELSE
93!            CALL iom_context_finalize( cwxios_context )
94!         ENDIF
95!         lrst_oce = .FALSE.
96!      ENDIF
97!      IF( kstp == nitend .OR. indic < 0 ) THEN
98!                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
99!      ENDIF
100!#endif
101!      !
102!      IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset
103      !
104   END SUBROUTINE stp_c1d
105
106#else
107   !!----------------------------------------------------------------------                                                                     
108   !!   Default key                                            NO 1D Config                                                                     
109   !!----------------------------------------------------------------------                                                                     
110CONTAINS
111   SUBROUTINE stp_c1d ( kt )      ! dummy routine                                                                                               
112      IMPLICIT NONE
113      INTEGER, INTENT( in ) :: kt
114      WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kt
115   END SUBROUTINE stp_c1d
116#endif
117   
118   !!======================================================================
119END MODULE step_c1d
Note: See TracBrowser for help on using the repository browser.