MODULE nemotam !!========================================================================== !! *** MODULE nemovar *** !! NEMOTAM system : Tangent and Adjoint for NEMO. !!========================================================================== !!---------------------------------------------------------------------- !! nemotam_main : Main driver routine for NEMOTAM !! nemotam_init : Initialization of NEMOTAM !! nemotam_final : Finish up NEMOTAM !!---------------------------------------------------------------------- !! History : !! 1.0 ! 07-06 (K. Mogensen) Initial version !! ! 09-06 (F. Vigilant) Modified to split NEMOVAR / NEMOTAM !! module tamctl i/o varctl !!--------------------------------------------------------------------- !!---------------------------------------------------------------------- !! * 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 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 #if defined key_tam USE opatam_tst_ini, ONLY : & & opa_opatam_ini, & & opa_4_tst_ini, & & opatam_4_tst_ini #endif IMPLICIT NONE PRIVATE !! * Module variables CHARACTER (len=64) :: & cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing LOGICAL, PUBLIC :: lini = .TRUE. ! initialisation flag !! * Routine accessibility PUBLIC & & nemotam_main, & & nemotam_banner CONTAINS SUBROUTINE nemotam_main !!---------------------------------------------------------------------- !! *** ROUTINE nemotam_main *** !! !! ** Purpose : Main driver routine for NEMOTAM !! !! ** Method : Nothing yet !! !! ** Action : Nothing yet !! !! History : !! ! 07-06 (K. Mogensen) Original code !!---------------------------------------------------------------------- !! * Local declarations ! Initialize grids and observations CALL nemotam_root ! Main inner loop CALL nemotam_sub ! Close all open files. CALL nemotam_final END SUBROUTINE nemotam_main SUBROUTINE nemotam_init !!---------------------------------------------------------------------- !! *** ROUTINE nemotam_init *** !! !! ** Purpose : Initialize grids and read observations and background !! !! ** Method : Read the namelist and call reading routines !! !! ** Action : Read the namelist and call reading routines !! !! History : !! ! 07-06 (K. Mogensen) Original code !! ! 01-09 (A. Weaver) Include ocean physics initialization !!---------------------------------------------------------------------- !! * Local declarations CHARACTER (len=128) :: file_out = 'nemovar.output' CHARACTER (len=*), PARAMETER :: namelistname = 'namelist.nemovar' NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & & isplt , jsplt , njctls, njctle, nbench, nbit_cmp ! open listing and namelist units CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) CALL nemotam_banner( numout ) ! Commented as opening is done in Nemotam_root ! CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & ! & 1, numout, .FALSE., 1 ) ! Namelist namctl : Control prints & Benchmark REWIND( numnam ) READ ( numnam, namctl ) ! Nodes selection narea = mynode() narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) lwp = narea == 1 ! open additionnal listing IF( narea-1 > 0 ) THEN WRITE(file_out,FMT="('nemotam.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 CALL nemotam_banner( numout ) 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 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 day( nit000 ) END SUBROUTINE nemotam_init SUBROUTINE nemotam_sub !!---------------------------------------------------------------------- !! *** ROUTINE nemotam_sub *** !! !! ** Purpose : Main driver routine for the NEMOTAM !! !! ** Method : !! !! ** Action : !! !! History : !! ! 07-08 (K. Mogensen) Original code based on appvar.F. !!---------------------------------------------------------------------- !! * Local declarations NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, & & ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, & & ln_tst_tan_cpd, ln_tst_tan REAL(wp) :: & & zcost, & & zcostf, & & zepsg, & & zctemp, & & zci_sim, & & zgi_sim, & & zcf_sim, & & zgf_sim, & & zcf_min, & & zgf_min, & & zcf_err, & & zgf_err, & & zcf_rel, & & zgf_rel INTEGER, DIMENSION(2) :: & & izs INTEGER :: & & i_prec_vecs, & & i_flag_rc, & & indic, & & ioutbef, & & iitr, & & isim, & & iabort INTEGER :: & & jnd1 CHARACTER(len=12) :: & & clstp, & & clend i_flag_rc = 0 ln_tst = .TRUE. ln_tst_obsadj = .FALSE. ln_tst_bkgadj = .FALSE. ln_tst_nemotam = .FALSE. ln_tst_grad = .FALSE. ln_tst_cpd_tam = .FALSE. ln_tst_stp_tam = .FALSE. ln_tst_tan_cpd = .FALSE. ln_tst_tan = .FALSE. REWIND( numnam ) READ ( numnam, namtst ) IF(lwp) THEN WRITE(numout,*) ' namtst' WRITE(numout,*) ' ' WRITE(numout,*) ' master switch for operator tests ln_tst = ',ln_tst WRITE(numout,*) ' switch for H adjoint tests ln_tst_obsadj = ',ln_tst_obsadj WRITE(numout,*) ' switch for B adjoint tests ln_tst_bkgadj = ',ln_tst_bkgadj WRITE(numout,*) ' switch for M adjoint tests ln_tst_nemotam = ',ln_tst_nemotam WRITE(numout,*) ' switch for gradient test ln_tst_grad = ',ln_tst_grad WRITE(numout,*) ' ' ENDIF ! B.4 Tests IF ( ln_tst ) CALL tstopt END SUBROUTINE nemotam_sub SUBROUTINE nemotam_final !!---------------------------------------------------------------------- !! *** ROUTINE nemotam_final *** !! !! ** Purpose : Finalize the NEMOTAM run !! !! ** Method : Close open files !! !! ** Action : Close open files !! !! History : !! ! 07-06 (K. Mogensen) Original code !!---------------------------------------------------------------------- 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 ! Unit close ! ---------- CLOSE( numnam ) ! namelist CLOSE( numout ) ! standard model output file IF ( .NOT. lini ) THEN CLOSE( numtan_sc ) ! tangent test diagnostic output CLOSE( numtan ) ! tangent diagnostic output ENDIF IF ( lk_mpp ) CALL mppstop END SUBROUTINE nemotam_final SUBROUTINE nemotam_banner(kumout) !!---------------------------------------------------------------------- !! *** ROUTINE nemotam_banner *** !! !! ** Purpose : Print a banner to a unit !! !! ** Method : Fortran !! !! ** Action : Fortran !! !! History : !! ! 07-06 (A. Vidard) Original code !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT(in) :: & & kumout ! Unit to print the banner to. WRITE(kumout,*) WRITE(kumout,*) ' VODA ' WRITE(kumout,*) ' NEMO Tangent and Adjoint Model' WRITE(kumout,*) ' Version 3.0b (2010) ' WRITE(kumout,*) END SUBROUTINE nemotam_banner SUBROUTINE nemotam_root !!---------------------------------------------------------------------- !! *** ROUTINE nemovar_root *** !! !! ** Purpose : Choose which init must be done according to test !! !! ** Method : Fortran !! !! ** Action : Fortran !! !! History : !! ! 09-07 (F. Vigilant) Original code !!---------------------------------------------------------------------- !! * Local declarations NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, & & ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, & & ln_tst_tan_cpd, ln_tst_tan CHARACTER (len=*), PARAMETER :: namelistname = 'namelist.nemotam' !! * Arguments ln_tst = .TRUE. ln_tst_obsadj = .FALSE. ln_tst_bkgadj = .FALSE. ln_tst_nemotam = .FALSE. ln_tst_grad = .FALSE. ln_tst_cpd_tam = .FALSE. ln_tst_stp_tam = .FALSE. ln_tst_tan_cpd = .FALSE. ln_tst_tan = .FALSE. CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & & 1, numout, .FALSE., 1 ) REWIND( numnam ) READ ( numnam, namtst ) IF ( ln_tst_tan ) THEN CALL opa_opatam_ini lini = .FALSE. ! not standard initialisation ELSE CALL nemotam_init END IF END SUBROUTINE nemotam_root END MODULE nemotam