MODULE tanhlt #if defined key_tam !!============================================================================== !! *** MODULE tan_htl *** !! Ocean system : TAN ocean dynamics (including on-line tracers and sea-ice) !!============================================================================== !!---------------------------------------------------------------------- !! tan_hlt : solve ocean dynamics, tracer and/or sea-ice !! tan_htl_init : initialization of the opa model !! tan_hlt_closefile : close remaining files !!---------------------------------------------------------------------- !! History : !! () Original code from opa !! ! 10-07 (F. Vigilant) Modification for tangent linear hyp !!---------------------------------------------------------------------- !! * Modules used USE dom_oce ! ocean space domain variables USE lib_mpp ! distributed memory computing USE daymod ! Date computations USE in_out_manager ! I/O manager 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 USE obcini USE phycst ! physical constant (par_cst routine) USE tamtrj ! handling of the trajectory USE trj_tam ! handling of the trajectory USE tamctl ! Control parameters USE oce_tam ! TL and adjoint data USE sbc_oce_tam ! Surface BCs tangent and adjoint arrays USE trc_oce_tam ! Trend tangent and adjoint arrays USE sol_oce_tam ! Solver tangent and adjoint arrays USE tamtst ! Gradient testing ! ocean physics #if defined key_tam USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) USE ldftra ! lateral diffusivity setting (ldftra_init routine) #endif USE zdfini USE step_tam USE istate_tam !: Initial state setting (istate_init routine) USE par_tlm USE hltinc, ONLY : & & hlt_inc_bld IMPLICIT NONE PRIVATE !! * Module variables CHARACTER (len=64) :: & cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing !! * Routine accessibility PUBLIC tan_hlt ! called by hlttst.F90 CONTAINS SUBROUTINE tan_hlt !!---------------------------------------------------------------------- !! *** ROUTINE tan_hlt *** !! !! ** Purpose : tan_hlt !! !! ** Method : - model general initialization !! - launch the time-stepping (stp_tan routine) !! !! References : !!---------------------------------------------------------------------- INTEGER :: istp ! time step index !!---------------------------------------------------------------------- #if defined key_agrif CALL ctl_stop( ' Agrif not available') #endif CALL tan_hlt_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) ! CALL ctl_stop( ' lk_c1d not available') ! ELSE istp = nit000 - 1 CALL trj_rea( istp, 1 ) CALL hlt_inc_bld( nstg ) ! increment builder istp = nit000 CALL istate_init_tan IF( ln_trjwri_tan ) CALL tl_trj_wri( istp ) DO WHILE ( istp <= nitend .AND. nstop == 0 ) #if defined key_agrif CALL ctl_stop( ' Agrif not available') #else CALL stp_tan( istp ) #endif istp = istp + 1 IF( ln_trjwri_tan ) CALL tl_trj_wri( istp ) 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 tan_hlt_final IF( lk_mpp ) CALL mppstop ! Close all files (mpp) ! END SUBROUTINE tan_hlt SUBROUTINE tan_hlt_init !!---------------------------------------------------------------------- !! *** ROUTINE tan_hlt_init *** !! !! ** Purpose : initialization of the tan model !! !!---------------------------------------------------------------------- #if defined key_coupled INTEGER :: itro, istp0 ! ??? #endif #if defined key_oasis3 || defined key_oasis4 INTEGER :: localComm #endif !! * Local declarations CHARACTER (len=128) :: file_out = 'nemohlt.output' ! CHARACTER (len=*), PARAMETER :: namelistname = 'namelist.hlt' NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & & isplt , jsplt , njctls, njctle, nbench, nbit_cmp NAMELIST/namtst/ ln_tst_nemotam, ln_tst_cpd_tam, ln_tst_stp_tam, & & ln_tst_tan_cpd, ln_tst_tan, ln_tst_stop !!---------------------------------------------------------------------- ! Initializations ! =============== ! Namelist namctl : Control prints & Benchmark REWIND( numnam ) READ ( numnam, namctl ) ! open additionnal listing IF( ln_ctl ) THEN IF( narea-1 > 0 ) THEN WRITE(file_out,FMT="('nemohlt.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 ! Parameter control and print ! --------------------------- IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' LINEAR-TANGENT HYPOTHESIS TEST-RUN ' WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' WRITE(numout,*) ' Namelist namhlt' WRITE(numout,*) ' run stage nstg = ', nstg IF( nstg == 1 ) THEN WRITE(numout,*) ' temperature increment switch ln_hltt = ', ln_hltt WRITE(numout,*) ' salinity increment switch ln_hlts = ', ln_hlts WRITE(numout,*) ' velocity incr. switch ln_hltuv = ', ln_hltuv WRITE(numout,*) ' sea surface height incr. switch ln_hltssh = ', ln_hltssh ENDIF WRITE(numout,*) WRITE(numout,*) ENDIF ! CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & ! & 1, numout, .FALSE., 1 ) ! Namelist namctl : Control prints & Benchmark REWIND( numnam ) READ ( numnam, namctl ) ! Nodes selection nproc = mynode() narea = nproc + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) lwp = narea == 1 ln_rstart = .FALSE. ! open additionnal listing IF( narea-1 > 0 ) THEN WRITE(file_out,FMT="('nemohlt.output_',I4.4)") narea-1 IF( numout /= 0 .AND. numout /= 6 ) THEN CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) ENDIF lwp = .TRUE. ! ENDIF IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'nemotam_init: 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,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp ENDIF ln_tst_nemotam = .FALSE. ln_tst_cpd_tam = .FALSE. ln_tst_stp_tam = .FALSE. ln_tst_tan_cpd = .FALSE. ln_tst_tan = .FALSE. ln_tst_stop = .FALSE. REWIND( numnam ) READ ( numnam, namtst ) IF(lwp) THEN WRITE(numout,*) ' namtst' WRITE(numout,*) ' ' WRITE(numout,*) ' switch for M adjoint tests ln_tst_nemotam = ',ln_tst_nemotam WRITE(numout,*) ' stop after tests ln_tst_stop = ',ln_tst_stop WRITE(numout,*) ' ' ENDIF 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_obc ) CALL obc_init ! Open boundaries ! ! Ocean physics #if defined key_tam CALL ldf_dyn_init ! Lateral ocean momentum physics CALL ldf_tra_init ! Lateral ocean tracer physics #endif CALL zdf_init ! Vertical ocean physics CALL oce_tam_init( 0 ) ! OCE TAM field CALL sol_oce_tam_init( 0 ) ! Initialize elliptic solver CALL trc_oce_tam_init( 0 ) ! TRC TAM fields #if defined key_tam CALL sbc_oce_tam_init( 0 ) ! SBC TAM fields #endif CALL tam_trj_ini CALL tl_trj_ini CALL day_init CALL day( nit000 ) END SUBROUTINE tan_hlt_init SUBROUTINE tan_hlt_final !!---------------------------------------------------------------------- !! *** ROUTINE opa_closefile *** !! !! ** Purpose : Close the files !! !! ** Method : !! !! History : !! 9.0 ! 05-01 (O. Le Galloudec) Original code !!---------------------------------------------------------------------- !! * Modules used !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA IF( nstop /= 0 ) THEN ! error print IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) nstop, ' error have been found' ENDIF IF ( lk_mpp ) CALL mppsync ! Deallocate variables ! -------------------- CALL oce_tam_deallocate ( 0 ) CALL sol_oce_tam_deallocate ( 0 ) #if defined key_tam CALL sbc_oce_tam_deallocate ( 0 ) CALL trc_oce_tam_deallocate ( 0 ) #endif CALL trj_deallocate ! Unit close ! ---------- CLOSE( numnam ) ! namelist CLOSE( numout ) ! standard model output file ! CLOSE( numtan_sc ) ! tangent test diagnostic output ! CLOSE( numtan ) ! tangent diagnostic output IF ( lk_mpp ) CALL mppstop END SUBROUTINE tan_hlt_final !!====================================================================== #endif END MODULE tanhlt