MODULE opa !!============================================================================== !! *** MODULE opa *** !! Ocean system : OPA ocean dynamics (including on-line tracers and sea-ice) !!============================================================================== !!---------------------------------------------------------------------- !! opa_model : solve ocean dynamics, tracer and/or sea-ice !!---------------------------------------------------------------------- !! * Modules used USE dom_oce ! ocean space domain variables USE oce ! dynamics and tracers variables USE in_out_manager ! I/O manager USE lib_mpp ! distributed memory computing USE domcfg ! domain configuration (dom_cfg routine) USE mppini ! shared/distributed memory setting (mpp_init routine) USE domain ! domain initialization (dom_init routine) USE istate ! initial state setting (istate_init routine) USE eosbn2 ! equation of state (eos bn2 routine) ! ocean physics USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine) USE traqsr ! solar radiation penetration (tra_qsr_init routine) USE trabbl ! bottom boundary layer (tra_bbl_init routine) USE zpshde ! partial step: hor. derivative (zps_hde_init routine) USE zdfini USE zdfddm USE zdfkpp USE phycst ! physical constant (par_cst routine) USE dtadyn ! Lecture and Interpolation of the dynamical fields USE trcini ! Initilization of the passive tracers USE stpctl USE daymod ! calendar (day routine) USE trcstp ! passive tracer time-stepping (trc_stp routine) USE dtadyn ! Lecture and interpolation of the dynamical fields USE stpctl ! time stepping control (stp_ctl routine) USE iom #if defined key_iomput USE mod_ioclient #endif IMPLICIT NONE PRIVATE !! * Module variables CHARACTER (len=64) :: & cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing !! * Routine accessibility PUBLIC opa_model ! called by model.F90 PUBLIC opa_init !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Id$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS SUBROUTINE opa_model !!---------------------------------------------------------------------- !! *** ROUTINE opa *** !! !! ** Purpose : opa solves the primitive equations on an orthogonal !! curvilinear mesh on the sphere. !! !! ** Method : - model general initialization !! - launch the time-stepping (stp routine) !! !! References : !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual. !! internal report, IPSL. !!---------------------------------------------------------------------- INTEGER :: istp, indic ! time step index !!---------------------------------------------------------------------- CALL opa_init ! Initializations IF( lk_mpp ) CALL mpp_max( nstop ) ! check that all process are still there... If some process have an error, ! they will never enter in step and other processes will wait until the end of the cpu time! IF( lk_mpp ) CALL mpp_max( nstop ) istp = nit000 ! DO WHILE ( istp <= nitend .AND. nstop == 0 ) ! IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) CALL iom_setkt( istp ) ! say to iom that we are at time step kstp CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields CALL trc_stp ( istp ) ! time-stepping CALL stp_ctl ( istp, indic ) ! Time loop: control and print istp = istp + 1 IF( lk_mpp ) CALL mpp_max( nstop ) END DO ! ! ========= ! ! ! Job end ! ! ! ========= ! IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA IF( nstop /= 0 .AND. lwp ) THEN ! error print WRITE(numout,cform_err) WRITE(numout,*) nstop, ' error have been found' ENDIF CALL opa_closefile IF( lk_mpp ) CALL mppstop ! Close all files (mpp) ! END SUBROUTINE opa_model SUBROUTINE opa_init !!---------------------------------------------------------------------- !! *** ROUTINE opa_init *** !! !! ** Purpose : opa solves the primitive equations on an orthogonal !! curvilinear mesh on the sphere. !! !! ** Method : - model general initialization !! !! References : !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual. !! internal report, IPSL. !! !! History : !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec) !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti, !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, !! G. Caniaux, B. Colot, C. Maes ) release 7.1 !! ! 92-06 (L.Terray) coupling implementation !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti, !! M. Guyon, A. Lazar, P. Delecluse, L.Terray, !! M.A. Filiberti, J. Vialar, A.M. Treguier, !! M. Levy) release 8.0 !! 8.1 ! 97-06 (M. Imbard, G. Madec) !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules !!---------------------------------------------------------------------- !! * Local declarations #if defined key_oasis3 || defined key_oasis4 || defined key_iomput INTEGER :: ilocal_comm #endif CHARACTER(len=80),dimension(10) :: cltxt = '' INTEGER :: ji ! local loop indices !! NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench !!---------------------------------------------------------------------- ! ! ! open Namelist file CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) ! READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark ! ! !--------------------------------------------! ! ! set communicator & select the local node ! ! !--------------------------------------------! #if defined key_iomput # if defined key_oasis3 || defined key_oasis4 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) # else CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server # endif narea = mynode( cltxt, ilocal_comm ) ! Nodes selection #else # if defined key_oasis3 || defined key_oasis4 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) # else narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) # endif #endif narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print IF(lwp) THEN ! open listing units ! CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) ! WRITE(numout,*) WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean' WRITE(numout,*) ' NEMO team' WRITE(numout,*) ' Ocean General Circulation Model' WRITE(numout,*) ' version 3.2 (2009) ' WRITE(numout,*) WRITE(numout,*) DO ji = 1, SIZE(cltxt) IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode END DO WRITE(numout,cform_aaa) ! Flag AAAAAAA ! ENDIF CALL opa_flg ! Control prints & Benchmark ! ! ============================== ! ! ! Model general initialization ! ! ! ============================== ! IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA ! Domain decomposition ! Domain decomposition IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out ELSE ; CALL mpp_init2 ! eliminate land processors ENDIF ! ! General initialization CALL phy_cst ! Physical constants CALL eos_init ! Equation of state CALL dom_cfg ! Domain configuration CALL dom_init ! Domain IF( ln_zps ) CALL zps_hde_init ! Partial steps: horizontal derivative CALL istate_init ! ocean initial state (Dynamics and tracers) ! ! Ocean physics IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & & CALL zdf_ddm_init ! double diffusive mixing #if ! defined key_degrad CALL ldf_tra_init ! Lateral ocean tracer physics #endif IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing ! ! Active tracers CALL tra_qsr_init ! penetrative solar radiation qsr IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme ! ! Passive tracers CALL trc_init ! Passive tracers initialization ! ! Dynamics CALL dta_dyn_init ! Initialization for the dynamics CALL iom_init ! iom_put initialization IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA END SUBROUTINE opa_init SUBROUTINE opa_flg !!---------------------------------------------------------------------- !! *** ROUTINE opa *** !! !! ** Purpose : Initialise logical flags that control the choice of !! some algorithm or control print !! !! ** Method : - print namctl information !! - Read in namilist namflg logical flags !!---------------------------------------------------------------------- IF(lwp) THEN ! Parameter print WRITE(numout,*) WRITE(numout,*) 'opa_flg: Control prints & Benchmark' WRITE(numout,*) '~~~~~~~ ' WRITE(numout,*) ' Namelist namctl' WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl WRITE(numout,*) ' level of print nn_print = ', nn_print WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench ENDIF nprint = nn_print ! convert DOCTOR namelist names into OLD names nictls = nn_ictls nictle = nn_ictle njctls = nn_jctls njctle = nn_jctle isplt = nn_isplt jsplt = nn_jsplt nbench = nn_bench ! ! Parameter control ! IF( ln_ctl ) THEN ! sub-domain area indices for the control prints IF( lk_mpp ) THEN isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real splitted domain ELSE IF( isplt == 1 .AND. jsplt == 1 ) THEN CALL ctl_warn( ' - isplt & jsplt are equal to 1', & & ' - the print control will be done over the whole domain' ) ENDIF ijsplt = isplt * jsplt ! total number of processors ijsplt ENDIF IF(lwp) WRITE(numout,*)' - The total number of processors over which the' IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt ! ! ! indices used for the SUM control IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area lsp_area = .FALSE. ELSE ! print control done over a specific area lsp_area = .TRUE. IF( nictls < 1 .OR. nictls > jpiglo ) THEN CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) nictls = 1 ENDIF IF( nictle < 1 .OR. nictle > jpiglo ) THEN CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) nictle = jpiglo ENDIF IF( njctls < 1 .OR. njctls > jpjglo ) THEN CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) njctls = 1 ENDIF IF( njctle < 1 .OR. njctle > jpjglo ) THEN CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) njctle = jpjglo ENDIF ENDIF ENDIF IF( nbench == 1 ) THEN ! Benchmark SELECT CASE ( cp_cfg ) CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', & & ' key_gyre must be used or set nbench = 0' ) END SELECT ENDIF END SUBROUTINE opa_flg SUBROUTINE opa_closefile !!---------------------------------------------------------------------- !! *** ROUTINE opa_closefile *** !! !! ** Purpose : Close the files !! !! ** Method : !! !! History : !! 9.0 ! 05-01 (O. Le Galloudec) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- IF ( lk_mpp ) CALL mppsync ! 1. Unit close ! ------------- CLOSE( numnam ) ! namelist CLOSE( numout ) ! standard model output file IF(lwp) CLOSE( numstp ) ! time-step file CALL iom_close ! close all input/output files END SUBROUTINE opa_closefile !!====================================================================== END MODULE opa