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 !! opa_init : initialization of the opa model !! opa_flg : initialisation of algorithm flag !! opa_closefile : close remaining files !!---------------------------------------------------------------------- !! 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 !! " ! 04-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces !! " ! 04-08 (C. Talandier) New trends organization !! " ! 05-06 (C. Ethe) Add the 1D configuration possibility !! " ! 05-11 (V. Garnier) Surface pressure gradient organization !! " ! 06-03 (L. Debreu, C. Mazauric) Agrif implementation !! " ! 06-04 (G. Madec, R. Benshila) Step reorganization !!---------------------------------------------------------------------- !! * Modules used USE oce ! dynamics and tracers variables USE cpl_oce ! ocean-atmosphere-sea ice coupled exchanges USE dom_oce ! ocean space domain variables USE sbc_oce ! surface boundary condition: ocean USE trdmod_oce ! ocean variables trends USE daymod ! calendar 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 obc_par ! open boundary cond. parameters USE obcini ! open boundary cond. initialization (obc_ini routine) USE istate ! initial state setting (istate_init routine) USE eosbn2 ! equation of state (eos bn2 routine) USE zpshde ! partial step: hor. derivative (zps_hde routine) ! ocean physics USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) USE ldftra ! lateral diffusivity setting (ldftra_init routine) USE zdfini USE phycst ! physical constant (par_cst routine) USE ocfzpt ! ocean freezing point (oc_fz_pt routine) USE trdmod ! momentum/tracers trends (trd_mod_init routine) USE diaptr ! poleward transports (dia_ptr_init routine) USE step ! OPA time-stepping (stp routine) #if defined key_oasis3 USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5) #elif defined key_oasis4 USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5) #endif USE dynspg_oce ! Control choice of surface pressure gradient schemes USE prtctl ! Print control (prt_ctl_init routine) USE c1d ! 1D configuration USE dyncor_c1d ! Coriolis factor at T-point USE step_c1d ! Time stepping loop for the 1D configuration USE initrc ! Initialization of the passive tracers 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$ !! Software governed by the CeCILL licence (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 ! time step index !!---------------------------------------------------------------------- #if defined key_agrif CALL Agrif_Init_Grids() #endif CALL opa_init ! Initializations ! 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 IF( lk_c1d ) THEN ! 1D configuration (no AGRIF zoom) ! DO WHILE ( istp <= nitend .AND. nstop == 0 ) CALL stp_c1d( istp ) istp = istp + 1 END DO ELSE ! 3D ocean with or without AGRIF zoom ! DO WHILE ( istp <= nitend .AND. nstop == 0 ) #if defined key_agrif CALL Agrif_Step( stp ) #else CALL stp( istp ) #endif istp = istp + 1 IF( lk_mpp ) CALL mpp_max( nstop ) END DO ENDIF ! ! ========= ! ! ! 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 defined key_oasis3 || defined key_oasis4 call cpl_prism_finalize #else IF( lk_mpp ) CALL mppstop ! Close all files (mpp) #endif ! END SUBROUTINE opa_model SUBROUTINE opa_init !!---------------------------------------------------------------------- !! *** ROUTINE opa_init *** !! !! ** Purpose : initialization of the opa model !! !!---------------------------------------------------------------------- #if defined key_coupled INTEGER :: itro, istp0 ! ??? #endif #if defined key_oasis3 || defined key_oasis4 INTEGER :: localComm #endif CHARACTER (len=20) :: namelistname CHARACTER (len=28) :: file_out NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & & isplt , jsplt , njctls, njctle, nbench, nbit_cmp !!---------------------------------------------------------------------- ! Initializations ! =============== file_out = 'ocean.output' ! open listing and namelist units CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & & 'SEQUENTIAL', 1, 6, .FALSE., 1 ) WRITE(numout,*) WRITE(numout,*) ' L O D Y C - I P S L' WRITE(numout,*) ' O P A model' WRITE(numout,*) ' Ocean General Circulation Model' WRITE(numout,*) ' version OPA 9.0 (2005) ' WRITE(numout,*) WRITE(numout,*) namelistname = 'namelist' CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & & 1, numout, .FALSE., 1 ) ! Namelist namctl : Control prints & Benchmark REWIND( numnam ) READ ( numnam, namctl ) #if defined key_oasis3 || defined key_oasis4 call cpl_prism_init(localComm) ! Nodes selection narea = mynode(localComm) #else ! Nodes selection narea = mynode() #endif narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) lwp = narea == 1 ! open additionnal listing IF( ln_ctl ) THEN IF( narea-1 > 0 ) THEN WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) lwp = .TRUE. ! WRITE(numout,*) WRITE(numout,*) ' L O D Y C - I P S L' WRITE(numout,*) ' O P A model' WRITE(numout,*) ' Ocean General Circulation Model' WRITE(numout,*) ' version OPA 9.0 (2005) ' WRITE(numout,*) ' MPI Ocean output ' WRITE(numout,*) WRITE(numout,*) ENDIF ENDIF ! ! ============================== ! ! ! Model general initialization ! ! ! ============================== ! IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA CALL opa_flg ! Control prints & Benchmark ! Domain decomposition IF( jpni*jpnj == jpnij ) THEN CALL mpp_init ! standard cutting out ELSE CALL mpp_init2 ! eliminate land processors ENDIF CALL phy_cst ! Physical constants CALL dom_cfg ! Domain configuration CALL dom_init ! Domain IF( lk_c1d ) THEN ! adaptation for 1D configuration CALL cor_c1d ! redefine Coriolis at T-point umask(:,:,:) = tmask(:,:,:) ! U, V and T-points are the same vmask(:,:,:) = tmask(:,:,:) ! ENDIF IF( ln_ctl ) CALL prt_ctl_init ! Print control IF( lk_obc ) CALL obc_init ! Open boundaries CALL istate_init ! ocean initial state (Dynamics and tracers) CALL oc_fz_pt ! Surface freezing point ! ! Ocean physics CALL ldf_dyn_init ! Lateral ocean momentum physics CALL ldf_tra_init ! Lateral ocean tracer physics CALL zdf_init ! Vertical ocean physics CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends #if defined key_passivetrc CALL ini_trc ! Passive tracers #endif #if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4 itro = nitend - nit000 + 1 ! Coupled istp0 = NINT( rdt ) CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange #endif #if defined key_oasis3 || defined key_oasis4 CALL cpl_prism_define #endif CALL dia_ptr_init ! Poleward TRansports initialization ! ! =============== ! ! ! time stepping ! ! ! =============== ! IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA END SUBROUTINE opa_init SUBROUTINE opa_flg !!---------------------------------------------------------------------- !! *** ROUTINE opa *** !! !! ** Purpose : Initialize logical flags that control the choice of !! some algorithm or control print !! !! ** Method : Read in namilist namflg logical flags !! !! History : !! 9.0 ! 03-11 (G. Madec) Original code !!---------------------------------------------------------------------- !! * Local declarations NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst !!---------------------------------------------------------------------- ! Parameter control and print ! --------------------------- IF(lwp) THEN 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 nprint = ', nprint WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle WRITE(numout,*) ' number of proc. following i isplt = ', isplt WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench WRITE(numout,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp ENDIF ! ... Control the sub-domain area indices for the control prints IF( ln_ctl ) THEN IF( lk_mpp ) THEN ! the domain is forced to the real splitted domain in MPI isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 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 ! compute the total number of processors ijsplt ijsplt = isplt*jsplt 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 ! Control the indices used for the SUM control IF( nictls+nictle+njctls+njctle == 0 ) THEN ! the print control is done over the default area lsp_area = .FALSE. ELSE ! the print control is 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 ! IF( nictls+nictle+njctls+njctle == 0 ) ENDIF ! IF(ln_ctl) IF( nbench == 1 ) THEN 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 IF( nbit_cmp == 1 ) THEN CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', & & ' WARNING: RESULTS ARE NOT PHYSICAL.' ) ENDIF ! Read Namelist namflg : algorithm FLaG ! -------------------- REWIND ( numnam ) READ ( numnam, namflg ) ! Parameter control and print ! --------------------------- IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm' WRITE(numout,*) '~~~~~~~' WRITE(numout,*) ' Namelist namflg : set algorithm flags' WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp WRITE(numout,*) ' hydrostatic pressure gradient' WRITE(numout,*) ' add dynhpg implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst WRITE(numout,*) ' in restart ot not nn_dynhpg_rst' ENDIF IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart 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 !!---------------------------------------------------------------------- !! * Modules used USE dtatem ! temperature data USE dtasal ! salinity data !!---------------------------------------------------------------------- IF ( lk_mpp ) CALL mppsync ! 1. Unit close ! ------------- CLOSE( numnam ) ! namelist CLOSE( numout ) ! standard model output file IF(lwp) CLOSE( numstp ) ! time-step file IF(lwp) CLOSE( numsol ) END SUBROUTINE opa_closefile !!====================================================================== END MODULE opa