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.
Changeset 2587 – NEMO

Changeset 2587


Ignore:
Timestamp:
2011-02-15T12:58:59+01:00 (13 years ago)
Author:
vidard
Message:

refer to ticket #798

Location:
branches/TAM_V3_0
Files:
11 added
39 edited
2 moved

Legend:

Unmodified
Added
Removed

  • branches/TAM_V3_0/NEMO/OPA_SRC/TAM/tamtrj.F90

    r1946 r2587  
    1818#endif 
    1919   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory 
     20#if   defined key_ldfslp 
    2021   USE ldfslp, ONLY : &   ! Slopes of neutral surfaces 
    2122      & uslp, wslpi,  &   ! i_slope at U- and W-points 
    2223      & vslp, wslpj       ! j-slope at V- and W-points 
     24#endif 
    2325   USE tradmp             ! Tracer damping 
    2426   USE sol_oce, ONLY : &  ! Solver variables defined in memory 

  • branches/TAM_V3_0/NEMO/OPA_SRC/mppsum.F90

    r1945 r2587  
    8686         & jj 
    8787 
    88  
     88      ! initialise to avoid uninitialised variables trapping of some compilers to complain. 
     89      zres = 0.0_wp ; zerr = 0.0_wp ; zbuffl(:) = 0.0_wp 
    8990      ! Get global number of elements 
    9091      ing = kn 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynadv_tam.F90

    r1885 r2587  
    547547      END IF 
    548548   END SUBROUTINE dyn_adv_ctl_tam 
    549  
     549#if defined key_tst_tlm 
    550550   SUBROUTINE dyn_adv_tlm_tst( kumadt ) 
    551551      !!----------------------------------------------------------------------- 
    … …  
    580580      USE tamtrj              ! writing out state trajectory 
    581581      USE par_tlm,    ONLY: & 
     582        & tlm_bch,          & 
    582583        & cur_loop,         & 
    583584        & h_ratio 
    … …  
    641642 
    642643      CHARACTER(LEN=14)   :: cl_name 
    643       CHARACTER (LEN=128) :: file_out, file_wop 
     644      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    644645      CHARACTER (LEN=90)  ::  FMT 
    645646      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    696697      ! Output filename Xn=F(X0) 
    697698      !-------------------------------------------------------------------- 
    698       file_wop='trj_wop_dynadv' 
    699  
    700699      CALL tlm_namrd 
    701700      gamma = h_ratio 
    702  
     701      file_wop='trj_wop_dynadv' 
     702      file_xdx='trj_xdx_dynadv' 
    703703      !-------------------------------------------------------------------- 
    704704      ! Initialize the tangent input with random noise: dx 
    … …  
    741741      ! Complete Init for Direct 
    742742      !------------------------------------------------------------------- 
    743       CALL istate_p   
     743      IF ( tlm_bch /= 2 )      CALL istate_p   
    744744 
    745745      ! *** initialize the reference trajectory 
    … …  
    769769      !  Compute the direct model F(X0,t=n) = Xn 
    770770      !-------------------------------------------------------------------- 
    771       CALL dyn_adv(nit000) 
    772       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     771      IF ( tlm_bch /= 2 ) CALL dyn_adv(nit000) 
     772      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     773      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    773774      !-------------------------------------------------------------------- 
    774775      !  Compute the Tangent  
    775776      !-------------------------------------------------------------------- 
    776       IF ( cur_loop .NE. 0) THEN 
    777          !-------------------------------------------------------------------- 
    778          !  Storing data 
    779          !--------------------------------------------------------------------   
    780          zua_out  (:,:,:) = ua   (:,:,:) 
    781          zva_out  (:,:,:) = va   (:,:,:)           
    782  
     777      IF ( tlm_bch == 2 ) THEN         
    783778         !-------------------------------------------------------------------- 
    784779         ! Initialize the tangent variables  
    … …  
    812807         zua_wop  (:,:,:) = ua  (:,:,:) 
    813808         zva_wop  (:,:,:) = va  (:,:,:) 
     809         CALL trj_rd_spl(file_xdx)  
     810         zua_out  (:,:,:) = ua  (:,:,:) 
     811         zva_out  (:,:,:) = va  (:,:,:) 
    814812         !-------------------------------------------------------------------- 
    815813         ! Compute the Linearization Error  
    … …  
    944942   END SUBROUTINE dyn_adv_tlm_tst 
    945943#endif 
     944#endif 
    946945END MODULE dynadv_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynhpg_tam.F90

    r1885 r2587  
    109109   PUBLIC   dyn_hpg_adj    ! routine called by step_tam module 
    110110   PUBLIC   dyn_hpg_adj_tst! routine called by test module 
     111#if defined key_tst_tlm 
    111112   PUBLIC   dyn_hpg_tlm_tst! routine called by test module 
     113#endif 
    112114 
    113115   !!* Namelist nam_dynhpg : Choice of horizontal pressure gradient computation 
    … …  
    10591061         &              ) 
    10601062   END SUBROUTINE dyn_hpg_adj_tst 
    1061  
     1063#if defined key_tst_tlm 
    10621064   SUBROUTINE dyn_hpg_tlm_tst( kumadt ) 
    10631065      !!----------------------------------------------------------------------- 
    … …  
    10891091      USE tamtrj              ! writing out state trajectory 
    10901092      USE par_tlm,    ONLY: & 
     1093        & tlm_bch,          & 
    10911094        & cur_loop,         & 
    10921095        & h_ratio 
    … …  
    11601163         & jk 
    11611164      CHARACTER(LEN=14)   :: cl_name 
    1162       CHARACTER (LEN=128) :: file_out, file_wop 
     1165      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    11631166      CHARACTER (LEN=90)  ::  FMT 
    11641167      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    12281231      ! Output filename Xn=F(X0) 
    12291232      !-------------------------------------------------------------------- 
    1230       file_wop='trj_wop_dynhpg' 
    1231  
    12321233      CALL tlm_namrd 
    12331234      gamma = h_ratio   
    1234  
     1235      file_wop='trj_wop_dynhpg' 
     1236      file_xdx='trj_xdx_dynhpg' 
    12351237       !-------------------------------------------------------------------- 
    12361238      ! Initialize the tangent input with random noise: dx 
    … …  
    12621264      ! Complete Init for Direct 
    12631265      !------------------------------------------------------------------- 
    1264       CALL istate_p   
     1266      IF ( tlm_bch /= 2 )      CALL istate_p   
    12651267 
    12661268      ! *** initialize the reference trajectory 
    … …  
    12961298      !  Compute the direct model F(X0,t=n) = Xn 
    12971299      !-------------------------------------------------------------------- 
    1298       CALL dyn_hpg(nit000) 
    1299       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     1300      IF ( tlm_bch /= 2 ) CALL dyn_hpg(nit000) 
     1301      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1302      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    13001303      !-------------------------------------------------------------------- 
    13011304      !  Compute the Tangent  
    13021305      !-------------------------------------------------------------------- 
    1303       IF ( cur_loop .NE. 0) THEN 
    1304          !-------------------------------------------------------------------- 
    1305          !  Storing data 
    1306          !--------------------------------------------------------------------   
    1307          zua_out  (:,:,:) = ua   (:,:,:) 
    1308          zva_out  (:,:,:) = va   (:,:,:)           
    1309  
     1306      IF ( tlm_bch == 2 ) THEN 
    13101307         !-------------------------------------------------------------------- 
    13111308         ! Initialize the tangent variables  
    … …  
    13241321         ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 
    13251322         !-------------------------------------------------------------------- 
    1326  
    13271323         zsp2_1    = DOT_PRODUCT( ua_tl, ua_tl  ) 
    13281324         zsp2_2    = DOT_PRODUCT( va_tl, va_tl  ) 
    … …  
    13341330         zua_wop  (:,:,:) = ua  (:,:,:) 
    13351331         zva_wop  (:,:,:) = va  (:,:,:) 
     1332         CALL trj_rd_spl(file_xdx)  
     1333         zua_out  (:,:,:) = ua  (:,:,:) 
     1334         zva_out  (:,:,:) = va  (:,:,:) 
    13361335         !-------------------------------------------------------------------- 
    13371336         ! Compute the Linearization Error  
    … …  
    14741473   !!====================================================================== 
    14751474#endif 
     1475#endif 
    14761476END MODULE dynhpg_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynldf_bilap_tam.F90

    r1885 r2587  
    471471            DO jj = jpjm1, 2, -1 
    472472               DO ji = fs_jpim1, fs_2, -1   ! vector opt. 
    473                   rotb_ad (ji  ,jj  ,jk) = rotb_ad (ji  ,jj  ,jk) & 
    474                                                   & + zlvad(ji,jj,jk) * fse3f(ji,jj  ,jk) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 
    475                   rotb_ad (ji-1,jj  ,jk) = rotb_ad (ji-1,jj  ,jk) & 
    476                                                   & - zlvad(ji,jj,jk) * fse3f(ji-1,jj,jk) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 
     473                  zufad   (ji  ,jj  ,jk) = zufad   (ji  ,jj  ,jk) + zlvad(ji  ,jj  ,jk) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )  
     474                  zufad   (ji-1,jj  ,jk) = zufad   (ji-1,jj  ,jk) - zlvad(ji  ,jj  ,jk) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )                    
    477475                  hdivb_ad(ji  ,jj  ,jk) = hdivb_ad(ji  ,jj  ,jk) - zlvad(ji,jj,jk) / e2v(ji,jj) 
    478476                  hdivb_ad(ji  ,jj+1,jk) = hdivb_ad(ji  ,jj+1,jk) + zlvad(ji,jj,jk) / e2v(ji,jj) 
    479477                  zlvad(ji,jj,jk) = 0.0_wp 
    480478 
    481                   rotb_ad (ji  ,jj  ,jk) = rotb_ad (ji  ,jj  ,jk) & 
    482                                                   & - zluad(ji,jj,jk) * fse3f(ji,jj  ,jk) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    483                   rotb_ad (ji  ,jj-1,jk) = rotb_ad (ji  ,jj-1,jk) & 
    484                                                   & + zluad(ji,jj,jk) * fse3f(ji,jj-1,jk) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     479                  zufad   (ji  ,jj  ,jk) = zufad   (ji  ,jj  ,jk) - zluad(ji  ,jj  ,jk) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     480                  zufad   (ji  ,jj-1,jk) = zufad   (ji  ,jj-1,jk) + zluad(ji  ,jj  ,jk) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    485481                  hdivb_ad(ji  ,jj  ,jk) = hdivb_ad(ji  ,jj  ,jk) - zluad(ji,jj,jk) / e1u(ji,jj) 
    486482                  hdivb_ad(ji+1,jj  ,jk) = hdivb_ad(ji+1,jj  ,jk) + zluad(ji,jj,jk) / e1u(ji,jj) 
    … …  
    488484               END DO 
    489485            END DO 
    490 !            DO jj = 1, jpj 
    491 !               DO ji = 1, jpi 
    492 !                  rotb_ad(ji,jj,jk) = rotb_ad(ji,jj,jk) + zufad(ji,jj,jk) * fse3f(ji,jj,jk) 
    493 !                  zufad(ji,jj,jk) = 0.0_wp 
    494 !               END DO 
    495 !            END DO 
     486            rotb_ad(:,:,jk) = rotb_ad(:,:,jk) + zufad(:,:,jk) * fse3f(:,:,jk) 
    496487         ELSE                            ! z-coordinate - full step 
    497488            DO jj = jpjm1, 2, -1 
    … …  
    501492                  hdivb_ad(ji  ,jj  ,jk) = hdivb_ad(ji  ,jj  ,jk) - zlvad(ji,jj,jk) / e2v(ji,jj) 
    502493                  hdivb_ad(ji  ,jj+1,jk) = hdivb_ad(ji  ,jj+1,jk) + zlvad(ji,jj,jk) / e2v(ji,jj) 
    503 !                  zlvad(ji,jj,jk) = 0.0_wp 
     494                  zlvad(ji,jj,jk) = 0.0_wp 
    504495 
    505496                  rotb_ad (ji  ,jj  ,jk) = rotb_ad (ji  ,jj  ,jk) - zluad(ji,jj,jk) / e2u(ji,jj) 
    … …  
    507498                  hdivb_ad(ji  ,jj  ,jk) = hdivb_ad(ji  ,jj  ,jk) - zluad(ji,jj,jk) / e1u(ji,jj) 
    508499                  hdivb_ad(ji+1,jj  ,jk) = hdivb_ad(ji+1,jj  ,jk) + zluad(ji,jj,jk) / e1u(ji,jj) 
    509 !                  zlvad(ji,jj,jk) = 0.0_wp 
     500                  zlvad(ji,jj,jk) = 0.0_wp 
    510501               END DO   
    511502            END DO   

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynldf_tam.F90

    r1885 r2587  
    287287         & ji,    &        ! dummy loop indices 
    288288         & jj,    &         
    289          & jk      
     289         & jk,    & 
     290         & jt      
    290291      INTEGER, DIMENSION(jpi,jpj) :: & 
    291292         & iseed_2d        ! 2D seed for the random number generator 
    … …  
    341342         & ) 
    342343 
     344      DO jt = 1, 2 
     345 
     346         IF (jt == 1) nldf=0  ! iso-level laplacian 
     347         IF (jt == 2) nldf=2  ! iso-level bilaplacian 
     348 
    343349      !================================================================== 
    344350      ! 1)      dx = ( ua_tl, va_tl, rotb_tl, hdivb_tl )  
    … …  
    426432      va_tl   (:,:,:) = zva_tlin   (:,:,:) 
    427433 
    428       CALL dyn_ldf_tan ( nit000 ) 
     434         IF (nldf == 0 )  CALL dyn_ldf_lap_tan(   nit000 ) 
     435         IF (nldf == 2 )  CALL dyn_ldf_bilap_tan( nit000 ) 
    429436 
    430437      zua_tlout(:,:,:) = ua_tl(:,:,:) 
    … …  
    463470      va_ad(:,:,:) = zva_adin(:,:,:) 
    464471 
    465       CALL dyn_ldf_adj ( nit000 ) 
     472         IF (nldf == 0 )  CALL dyn_ldf_lap_adj(   nit000 ) 
     473         IF (nldf == 2 )  CALL dyn_ldf_bilap_adj( nit000 ) 
    466474 
    467475      zua_adout   (:,:,:) = ua_ad   (:,:,:) 
    … …  
    482490      ! Compare the scalar products 
    483491      ! 14 char:'12345678901234' 
    484       cl_name = 'dyn_ldf_adj   ' 
     492         IF (nldf == 0 )  cl_name = 'dynldf_adj lap' 
     493         IF (nldf == 2 )  cl_name = 'dynldf_adj blp' 
    485494      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 
     495 
     496      END DO 
    486497 
    487498      DEALLOCATE( & 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynspg_flt_tam.F90

    r1885 r2587  
    178178      & stdemp,              & 
    179179      & stdssh,              & 
     180      & stdgc,               & 
    180181      & prntst_adj,          & 
    181182      & prntst_tlm            
    … …  
    187188   PUBLIC dyn_spg_flt_tan,     & ! routine called by step_tan.F90 
    188189      &   dyn_spg_flt_adj,     & ! routine called by step_adj.F90 
    189       &   dyn_spg_flt_adj_tst, & ! routine called by the tst.F90 
    190       &   dyn_spg_flt_tlm_tst 
    191  
     190      &   dyn_spg_flt_adj_tst    ! routine called by the tst.F90 
     191#if defined key_tst_tlm 
     192   PUBLIC dyn_spg_flt_tlm_tst 
     193#endif 
    192194   !! * Substitutions 
    193195#  include "domzgr_substitute.h90" 
    … …  
    13951397   END SUBROUTINE dyn_spg_flt_adj_tst 
    13961398 
    1397  
     1399#if defined key_tst_tlm 
    13981400   SUBROUTINE dyn_spg_flt_tlm_tst( kumadt ) 
    13991401      !!----------------------------------------------------------------------- 
    … …  
    14301432      USE tamtrj              ! writing out state trajectory 
    14311433      USE par_tlm,    ONLY: & 
     1434        & tlm_bch,          & 
    14321435        & cur_loop,         & 
    14331436        & h_ratio 
    … …  
    14381441      USE oce       , ONLY: & ! ocean dynamics and tracers variables 
    14391442        & ua, va, ub, vb,   & 
     1443        & un, vn, & 
    14401444        & sshb, sshn, wn 
    14411445      USE sbc_oce   , ONLY: & 
    14421446        & emp 
     1447      USE sol_oce           , ONLY: & ! ocean dynamics and tracers variables 
     1448        & gcb, gcx 
    14431449      USE tamctl,         ONLY: & ! Control parameters 
    14441450       & numtan, numtan_sc 
    … …  
    14691475         & zsshn_wop,  & 
    14701476         & z2r           ! 2D field 
     1477      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 
     1478         & zgcb_tlin ,     & ! Tangent input 
     1479         & zgcx_tlin ,     & ! Tangent input 
     1480         & zgcb_out  ,     & ! Direct output 
     1481         & zgcx_out  ,     & ! Direct output 
     1482         & zgcb_wop  ,     & ! Direct output without perturbation 
     1483         & zgcx_wop  ,     & ! Direct output without perturbation 
     1484         & zr             ! 3D random field 
    14711485      REAL(KIND=wp) :: & 
    14721486         & zsp1, zsp1_1, zsp1_2, zsp1_3, zsp1_4,  &   !  
    … …  
    14751489         & zzsp, zzsp_1, zzsp_2, zzsp_3, zzsp_4,  & 
    14761490         & gamma,                                 & 
     1491         & zsp_5,zsp1_5, zsp2_5, zsp3_5, zsp4_5,  & 
     1492         & zzsp_5, zsp_6, & 
    14771493         & zgsp1, zgsp2, zgsp3, zgsp4, zgsp5,     & 
    14781494         & zgsp6, zgsp7 
    … …  
    14851501         & jk 
    14861502      CHARACTER(LEN=14)   :: cl_name 
    1487       CHARACTER (LEN=128) :: file_out, file_wop 
     1503      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    14881504      CHARACTER (LEN=90)  ::  FMT 
    14891505      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    14921508         & zscsshb, zscsshn,    & 
    14931509         & zscerrsshb, zscerrsshn 
     1510      REAL(KIND=wp), DIMENSION(jpi,jpj) :: & 
     1511         & zerrgcb, zerrgcx 
     1512      REAL(KIND=wp), DIMENSION(100):: & 
     1513         & zscgcb,zscgcx,             & 
     1514         & zscerrgcb, zscerrgcx 
     1515      INTEGER, DIMENSION(100):: & 
     1516         & iiposgcb, ijposgcb,          & 
     1517         & iiposgcx, ijposgcx 
    14941518      INTEGER, DIMENSION(100):: & 
    14951519         & iipossshb, iipossshn, iiposua, iiposva,   & 
    … …  
    15301554         & z2r(jpi,jpj)         & 
    15311555         & ) 
     1556      ALLOCATE( & 
     1557         & zgcb_tlin( jpi,jpj),     & 
     1558         & zgcx_tlin( jpi,jpj),     & 
     1559         & zgcb_out ( jpi,jpj),     & 
     1560         & zgcx_out ( jpi,jpj),     & 
     1561         & zgcb_wop ( jpi,jpj),     & 
     1562         & zgcx_wop ( jpi,jpj),     & 
     1563         & zr(        jpi,jpj)      & 
     1564         & ) 
    15321565      !-------------------------------------------------------------------- 
    15331566      ! Reset variables 
    … …  
    15621595      zerrsshb(:,:)    = 0.0_wp 
    15631596      zerrsshn(:,:)    = 0.0_wp 
     1597 
     1598      zgcb_tlin( :,:) = 0.0_wp 
     1599      zgcx_tlin( :,:) = 0.0_wp 
     1600      zgcb_out ( :,:) = 0.0_wp 
     1601      zgcx_out ( :,:) = 0.0_wp 
     1602      zgcb_wop ( :,:) = 0.0_wp 
     1603      zgcx_wop ( :,:) = 0.0_wp 
     1604      zr(        :,:) = 0.0_wp 
    15641605      !-------------------------------------------------------------------- 
    15651606      ! Output filename Xn=F(X0) 
    15661607      !-------------------------------------------------------------------- 
    1567       file_wop='trj_wop_dynspg' 
    15681608      CALL tlm_namrd 
    15691609      gamma = h_ratio 
     1610      file_wop='trj_wop_dynspg' 
     1611      file_xdx='trj_xdx_dynspg' 
    15701612      !-------------------------------------------------------------------- 
    15711613      ! Initialize the tangent input with random noise: dx 
    … …  
    16301672            END DO 
    16311673         END DO 
     1674         CALL grid_rd_sd( 596035, zr,  c_solver_pt, 0.0_wp, stdgc)     
     1675         DO jj = nldj, nlej 
     1676            DO ji = nldi, nlei 
     1677               zgcb_tlin(ji,jj) = zr(ji,jj) 
     1678            END DO 
     1679         END DO      
     1680         CALL grid_rd_sd( 264792, zr,  c_solver_pt, 0.0_wp, stdgc)     
     1681         DO jj = nldj, nlej 
     1682            DO ji = nldi, nlei 
     1683               zgcx_tlin(ji,jj) = zr(ji,jj) 
     1684            END DO 
     1685         END DO 
    16321686      ENDIF     
    16331687 
    … …  
    16361690      !------------------------------------------------------------------- 
    16371691      CALL istate_p   
    1638  
    16391692      ! *** initialize the reference trajectory 
    16401693      ! ------------ 
    16411694      CALL  trj_rea( nit000-1, 1 ) 
    16421695      CALL  trj_rea( nit000, 1 ) 
    1643  
     1696      ua(:,:,:)=un(:,:,:) 
     1697      va(:,:,:)=vn(:,:,:) 
     1698      ub(:,:,:)=un(:,:,:) 
     1699      vb(:,:,:)=vn(:,:,:) 
     1700      gcx  (:,:) =  ua(:,:,1) / 10.0_wp 
     1701      gcb  (:,:) =  ua(:,:,3) / 10.0_wp 
    16441702 
    16451703      IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN 
    … …  
    16671725         zsshn_tlin(:,:) = gamma * zsshn_tlin(:,:) 
    16681726         sshn(:,:)       = sshn(:,:) + zsshn_tlin(:,:) 
     1727 
     1728         zgcb_tlin(:,:) = gamma * zgcb_tlin(:,:) 
     1729         gcb(:,:)       = gcb(:,:) + zgcb_tlin(:,:) 
     1730 
     1731         zgcx_tlin(:,:) = gamma * zgcx_tlin(:,:) 
     1732         gcx(:,:)       = gcx(:,:) + zgcx_tlin(:,:) 
    16691733      ENDIF 
    16701734 
    … …  
    16721736      !  Compute the direct model F(X0,t=n) = Xn 
    16731737      !-------------------------------------------------------------------- 
    1674       CALL dyn_spg_flt(nit000, indic) 
    1675       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     1738      IF ( tlm_bch /= 2 ) CALL dyn_spg_flt(nit000, indic) 
     1739      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1740      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    16761741      !-------------------------------------------------------------------- 
    16771742      !  Compute the Tangent  
    16781743      !-------------------------------------------------------------------- 
    1679       IF ( cur_loop .NE. 0) THEN 
    1680          !-------------------------------------------------------------------- 
    1681          !  Storing data 
    1682          !--------------------------------------------------------------------   
    1683          zua_out  (:,:,:) = ua   (:,:,:) 
    1684          zva_out  (:,:,:) = va   (:,:,:) 
    1685          zsshb_out(:,:  ) = sshb (:,:  ) 
    1686          zsshn_out(:,:  ) = sshn (:,:  ) 
     1744      IF ( tlm_bch == 2 ) THEN 
     1745         gcx_tl (:,:) = 0.0_wp 
     1746         gcxb_tl(:,:) = 0.0_wp 
     1747         gcb_tl (:,:) = 0.0_wp 
    16871748         !-------------------------------------------------------------------- 
    16881749         ! Initialize the tangent variables  
    … …  
    16981759         sshb_tl(:,:  ) = zsshb_tlin(:,:  ) 
    16991760         sshn_tl(:,:  ) = zsshn_tlin(:,:  ) 
     1761         gcb_tl  (:,:) = zgcb_tlin  (:,:) 
     1762         gcx_tl  (:,:) = zgcx_tlin  (:,:) 
    17001763 
    17011764         CALL dyn_spg_flt_tan(nit000, indic) 
    … …  
    17081771         zsp2_3    = DOT_PRODUCT( sshb_tl, sshb_tl  ) 
    17091772         zsp2_4    = DOT_PRODUCT( sshn_tl, sshn_tl  ) 
    1710          zsp2      = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4 
     1773         zsp_5    = DOT_PRODUCT( gcx_tl, gcx_tl  ) 
     1774         zsp_6    = DOT_PRODUCT( gcxb_tl, gcxb_tl  ) 
     1775 
     1776         zsp2      = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4 + zsp_5 + zsp_6 
    17111777         !-------------------------------------------------------------------- 
    17121778         !  Storing data 
    … …  
    17171783         zsshb_wop(:,:) = sshb(:,:) 
    17181784         zsshn_wop(:,:) = sshn(:,:) 
     1785         zgcx_wop  (:,:) = gcx  (:,:) 
     1786         CALL trj_rd_spl(file_xdx)  
     1787         zua_out  (:,:,:) = ua  (:,:,:) 
     1788         zva_out  (:,:,:) = va  (:,:,:) 
     1789         zsshb_out(:,:) = sshb(:,:) 
     1790         zsshn_out(:,:) = sshn(:,:) 
     1791         zgcx_out  (:,:) = gcx  (:,:) 
    17191792         !-------------------------------------------------------------------- 
    17201793         ! Compute the Linearization Error  
    … …  
    18091882            END DO 
    18101883         END DO 
     1884         ii=0 
     1885         DO jj = 1, jpj 
     1886            DO ji = 1, jpi 
     1887               zgcx_out   (ji,jj) = zgcx_out    (ji,jj) - zgcx_wop  (ji,jj) 
     1888               zgcx_wop   (ji,jj) = zgcx_out    (ji,jj) - gcx_tl    (ji,jj) 
     1889               IF (  gcx_tl(ji,jj) .NE. 0.0_wp ) zerrgcx(ji,jj) = zgcx_out(ji,jj)/gcx_tl(ji,jj) 
     1890               IF( (MOD(ji, isamp) .EQ. 0) .AND. & 
     1891               &   (MOD(jj, jsamp) .EQ. 0) ) THEN 
     1892                   ii = ii+1 
     1893                   iiposgcx(ii) = ji 
     1894                   ijposgcx(ii) = jj 
     1895                   IF ( INT(tmask(ji,jj,1)) .NE. 0)  THEN 
     1896                      zscgcx (ii)    =  zgcx_wop(ji,jj) 
     1897                      zscerrgcx (ii) =  ( zerrgcx(ji,jj) - 1.0_wp ) / gamma 
     1898                   ENDIF 
     1899               ENDIF 
     1900            END DO 
     1901         END DO 
    18111902         zsp1_1    = DOT_PRODUCT( zua_out,   zua_out    ) 
    18121903         zsp1_2    = DOT_PRODUCT( zva_out,   zva_out    ) 
    18131904         zsp1_3    = DOT_PRODUCT( zsshb_out, zsshb_out  ) 
    18141905         zsp1_4    = DOT_PRODUCT( zsshn_out, zsshn_out  ) 
    1815          zsp1      = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 
     1906         zsp1_5   = DOT_PRODUCT( zgcx_out, zgcx_out  ) 
     1907         zsp1      = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 + zsp1_5 
    18161908         zsp3_1    = DOT_PRODUCT( zua_wop,   zua_wop    ) 
    18171909         zsp3_2    = DOT_PRODUCT( zva_wop,   zva_wop    ) 
    18181910         zsp3_3    = DOT_PRODUCT( zsshb_wop, zsshb_wop  ) 
    18191911         zsp3_4    = DOT_PRODUCT( zsshn_wop, zsshn_wop  ) 
    1820          zsp3      = zsp3_1 + zsp3_2 + zsp3_3 + zsp3_4 
     1912         zsp3_5   = DOT_PRODUCT( zgcx_wop, zgcx_wop  ) 
     1913         zsp3      = zsp3_1 + zsp3_2 + zsp3_3 + zsp3_4 + zsp3_5 
    18211914 
    18221915         !-------------------------------------------------------------------- 
    … …  
    18301923         zzsp_3   = SQRT(zsp3_3) 
    18311924         zzsp_4   = SQRT(zsp3_4) 
     1925         zzsp_5   = SQRT(zsp3_5) 
    18321926         zgsp5    = zzsp 
    18331927         CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) 
    … …  
    18401934         zzsp_3   = SQRT(zsp2_3) 
    18411935         zzsp_4   = SQRT(zsp2_4) 
     1936         zzsp_5   = SQRT(zsp2_5) 
    18421937         zgsp4    = zzsp 
    18431938         cl_name = 'dynspg_tam:Ln2' 
    … …  
    18511946         zzsp_3   = SQRT(zsp1_3) 
    18521947         zzsp_4   = SQRT(zsp1_4) 
     1948         zzsp_5   = SQRT(zsp1_5) 
    18531949         cl_name  = 'dynspg:Mhdx-Mx' 
    18541950         CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) 
    … …  
    19182014   END SUBROUTINE dyn_spg_flt_tlm_tst 
    19192015#endif 
    1920  
     2016#endif 
    19212017#endif 
    19222018END MODULE dynspg_flt_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynspg_tam.F90

    r1885 r2587  
    5858   PUBLIC dyn_spg_tan,     &   ! routine called by steptan module 
    5959      &   dyn_spg_adj,     &   ! routine called by stepadj module 
    60       &   dyn_spg_adj_tst, &   ! routine controlling adjoint tests 
    61       &   dyn_spg_tlm_tst  
     60      &   dyn_spg_adj_tst      ! routine controlling adjoint tests 
     61#if defined key_tst_tlm 
     62   PUBLIC dyn_spg_tlm_tst 
     63#endif  
    6264 
    6365   !! * module variables 
    … …  
    262264 
    263265   END SUBROUTINE dyn_spg_ctl_tam 
    264  
     266#if defined key_tst_tlm 
    265267   SUBROUTINE dyn_spg_tlm_tst( kumadt ) 
    266268      !!----------------------------------------------------------------------- 
    … …  
    310312  !!====================================================================== 
    311313#endif 
     314#endif 
    312315END MODULE dynspg_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynvor_tam.F90

    r1885 r2587  
    1919   !!            9.0  !  08-06  (A. Vidard) Skeleton 
    2020   !!            9.0  !  09-01  (A. Vidard) TAM of the 06-11 version 
     21   !!            9.0  !  10-01  (F. Vigilant) Add een TAM option 
    2122   !!---------------------------------------------------------------------- 
    2223 
    … …  
    6869      & e3t_0,               & 
    6970#else 
     71      & e3t,                 & 
    7072      & e3u,                 & 
    7173      & e3v,                 & 
    … …  
    8183      & nlej,                & 
    8284      & umask,               & 
    83       & vmask 
     85      & vmask,               & 
     86      & tmask 
    8487   USE dynadv        , ONLY: & 
    8588      & ln_dynadv_vec ! vector form flag 
     89   USE lbclnk        , ONLY: & ! Lateral boundary conditions 
     90      & lbc_lnk 
    8691   USE in_out_manager, ONLY: & ! I/O manager 
    8792      & ctl_stop,            & 
    … …  
    146151      ! 
    147152      CASE ( -1 )                                      ! esopa: test all possibility with control print 
    148 !         CALL vor_ene_tan( kt, ntot, ua_tl, va_tl ) 
     153         CALL vor_ene_tan( kt, ntot, ua_tl, va_tl ) 
    149154         CALL vor_ens_tan( kt, ntot, ua_tl, va_tl ) 
    150155!         CALL vor_mix_tan( kt ) 
    151 !         CALL vor_een_tan( kt, ntot, ua_tl, va_tl ) 
     156         CALL vor_een_tan( kt, ntot, ua_tl, va_tl ) 
    152157         ! 
    153158      CASE ( 0 )                                       ! energy conserving scheme 
    154          CALL ctl_stop ('vor_ene_tan not available yet') 
    155 !         CALL vor_ene_tan( kt, ntot, ua_tl, va_tl )                ! total vorticity 
     159         CALL vor_ene_tan( kt, ntot, ua_tl, va_tl )                ! total vorticity 
    156160         ! 
    157161      CASE ( 1 )                                       ! enstrophy conserving scheme 
    … …  
    163167         ! 
    164168      CASE ( 3 )                                       ! energy and enstrophy conserving scheme 
    165          CALL ctl_stop ('vor_een_tan not available yet') 
    166 !         CALL vor_een_tan( kt, ntot, ua_tl, va_tl )                ! total vorticity 
     169         CALL vor_een_tan( kt, ntot, ua_tl, va_tl )                ! total vorticity 
    167170         ! 
    168171      END SELECT 
    169172 
    170173   END SUBROUTINE dyn_vor_tan 
     174   SUBROUTINE vor_ene_tan( kt, kvor, pua_tl, pva_tl ) 
     175      !!---------------------------------------------------------------------- 
     176      !!                  ***  ROUTINE vor_ene  *** 
     177      !! 
     178      !! ** Purpose :   Compute the now total vorticity trend and add it to  
     179      !!      the general trend of the momentum equation. 
     180      !! 
     181      !! ** Method  :   Trend evaluated using now fields (centered in time)  
     182      !!      and the Sadourny (1975) flux form formulation : conserves the 
     183      !!      horizontal kinetic energy. 
     184      !!      The trend of the vorticity term is given by: 
     185      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 
     186      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ] 
     187      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ] 
     188      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
     189      !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ] 
     190      !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ] 
     191      !!      Add this trend to the general momentum trend (ua,va): 
     192      !!          (ua,va) = (ua,va) + ( voru , vorv ) 
     193      !! 
     194      !! ** Action : - Update (ua,va) with the now vorticity term trend 
     195      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
     196      !!               and planetary vorticity trends) ('key_trddyn') 
     197      !! 
     198      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
     199      !!---------------------------------------------------------------------- 
     200      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
     201      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     202         !                                                        ! =nrvm (relative vorticity or metric) 
     203      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua_tl    ! total u-trend 
     204      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva_tl    ! total v-trend 
     205      !! 
     206      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
     207      REAL(wp) ::   zx1, zy1, zfact2   ! temporary scalars 
     208      REAL(wp) ::   zx2, zy2           !    "         " 
     209      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! temporary 2D workspace 
     210      REAL(wp) ::   zx1tl, zy1tl   ! temporary scalars 
     211      REAL(wp) ::   zx2tl, zy2tl           !    "         " 
     212      REAL(wp), DIMENSION(jpi,jpj) ::   zwxtl, zwytl, zwztl   ! temporary 2D workspace 
     213      !!---------------------------------------------------------------------- 
     214 
     215      IF( kt == nit000 ) THEN 
     216         IF(lwp) WRITE(numout,*) 
     217         IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme' 
     218         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     219      ENDIF 
     220 
     221      ! Local constant initialization 
     222      zfact2 = 0.5 * 0.5 
     223 
     224!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
     225      !                                                ! =============== 
     226      DO jk = 1, jpkm1                                 ! Horizontal slab 
     227         !                                             ! =============== 
     228         ! Potential vorticity and horizontal fluxes 
     229         ! ----------------------------------------- 
     230         SELECT CASE( kvor )      ! vorticity considered 
     231         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis) 
     232         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity 
     233         CASE ( 3 )                                                ! metric term 
     234            DO jj = 1, jpjm1 
     235               DO ji = 1, fs_jpim1   ! vector opt. 
     236                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     237                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     238                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     239               END DO 
     240            END DO 
     241         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity) 
     242         CASE ( 5 )                                                ! total (coriolis + metric) 
     243            DO jj = 1, jpjm1 
     244               DO ji = 1, fs_jpim1   ! vector opt. 
     245                  zwz(ji,jj) = ( ff (ji,jj)                                                                       & 
     246                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     247                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     248                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & 
     249                       &       ) 
     250               END DO 
     251            END DO 
     252         END SELECT 
     253         IF( ln_sco ) THEN 
     254            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 
     255            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     256            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     257         ELSE 
     258            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
     259            zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
     260         ENDIF 
     261 
     262 
     263! Tangent counterpart 
     264         SELECT CASE( kvor )      ! vorticity considered 
     265         CASE ( 1 )   ;   zwztl(:,:) = 0.      ! planetary vorticity (Coriolis) 
     266         CASE ( 2 )   ;   zwztl(:,:) =   rotn_tl(:,:,jk)                ! relative  vorticity 
     267         CASE ( 3 )                                                ! metric term 
     268            DO jj = 1, jpjm1 
     269               DO ji = 1, fs_jpim1   ! vector opt. 
     270                  zwztl(ji,jj) = (   ( vn_tl(ji+1,jj  ,jk) + vn_tl (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     271                       &         - ( un_tl(ji  ,jj+1,jk) + un_tl (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     272                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     273               END DO 
     274            END DO 
     275         CASE ( 4 )   ;   zwztl(:,:) = rotn_tl(:,:,jk)     ! total (relative + planetary vorticity) 
     276         CASE ( 5 )                                                ! total (coriolis + metric) 
     277            DO jj = 1, jpjm1 
     278               DO ji = 1, fs_jpim1   ! vector opt. 
     279                  zwztl(ji,jj) = (   ( vn_tl(ji+1,jj  ,jk) + vn_tl (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     280                       &           - ( un_tl(ji  ,jj+1,jk) + un_tl(ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     281                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               
     282                      
     283               END DO 
     284            END DO 
     285         END SELECT 
     286 
     287         IF( ln_sco ) THEN 
     288            zwztl(:,:) = zwztl(:,:) / fse3f(:,:,jk) 
     289            zwxtl(:,:) = e2u(:,:) * fse3u(:,:,jk) * un_tl(:,:,jk) 
     290            zwytl(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn_tl(:,:,jk) 
     291         ELSE 
     292            zwxtl(:,:) = e2u(:,:) * un_tl(:,:,jk) 
     293            zwytl(:,:) = e1v(:,:) * vn_tl(:,:,jk) 
     294         ENDIF 
     295 
     296         ! Compute and add the vorticity term trend 
     297         ! ---------------------------------------- 
     298         DO jj = 2, jpjm1 
     299            DO ji = fs_2, fs_jpim1   ! vector opt. 
     300               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1) 
     301               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  ) 
     302               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 
     303               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
     304               zy1tl = zwytl(ji,jj-1) + zwytl(ji+1,jj-1) 
     305               zy2tl = zwytl(ji,jj  ) + zwytl(ji+1,jj  ) 
     306               zx1tl = zwxtl(ji-1,jj) + zwxtl(ji-1,jj+1) 
     307               zx2tl = zwxtl(ji  ,jj) + zwxtl(ji  ,jj+1) 
     308               pua_tl(ji,jj,jk) = pua_tl(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwztl(ji  ,jj-1) * zy1 + zwz(ji  ,jj-1) * zy1tl + zwztl(ji,jj) * zy2 + zwz(ji,jj) * zy2tl ) 
     309               pva_tl(ji,jj,jk) = pva_tl(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwztl(ji-1,jj  ) * zx1 + zwz(ji-1,jj  ) * zx1tl + zwztl(ji,jj) * zx2 + zwz(ji,jj) * zx2tl )  
     310            END DO   
     311         END DO   
     312         !                                             ! =============== 
     313      END DO                                           !   End of slab 
     314      !                                                ! =============== 
     315   END SUBROUTINE vor_ene_tan 
    171316   SUBROUTINE vor_ens_tan( kt, kvor, pua_tl, pva_tl ) 
    172317      !!---------------------------------------------------------------------- 
    … …  
    340485   END SUBROUTINE vor_ens_tan 
    341486    
     487   SUBROUTINE vor_een_tan( kt, kvor, pua_tl, pva_tl ) 
     488      !!---------------------------------------------------------------------- 
     489      !!                ***  ROUTINE vor_een_tan  *** 
     490      !! 
     491      !! ** Purpose :   Compute the now total vorticity trend and add it to  
     492      !!      the general trend of the momentum equation. 
     493      !! 
     494      !! ** Method  :   Trend evaluated using now fields (centered in time)  
     495      !!      and the Arakawa and Lamb (19XX) flux form formulation : conserves  
     496      !!      both the horizontal kinetic energy and the potential enstrophy 
     497      !!      when horizontal divergence is zero. 
     498      !!      The trend of the vorticity term is given by: 
     499      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 
     500      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
     501      !!      Add this trend to the general momentum trend (ua,va): 
     502      !!          (ua,va) = (ua,va) + ( voru , vorv ) 
     503      !! 
     504      !! ** Action : - Update (ua,va) with the now vorticity term trend 
     505      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
     506      !!               and planetary vorticity trends) ('key_trddyn') 
     507      !! 
     508      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
     509      !!---------------------------------------------------------------------- 
     510      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
     511      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     512         !                                                        ! =nrvm (relative vorticity or metric) 
     513      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua_tl ! total u-trend 
     514      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva_tl ! total v-trend 
     515      !! 
     516      INTEGER ::   ji, jj, jk          ! dummy loop indices 
     517      REAL(wp) ::   zfac12, zua, zva   ! temporary scalars 
     518      REAL(wp) ::   zuatl, zvatl       ! temporary scalars 
     519      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz                    ! temporary 2D workspace 
     520      REAL(wp), DIMENSION(jpi,jpj) ::   ztnw, ztne, ztsw, ztse           ! temporary 3D workspace 
     521      REAL(wp), DIMENSION(jpi,jpj) ::   zwxtl, zwytl, zwztl              ! temporary 2D workspace 
     522      REAL(wp), DIMENSION(jpi,jpj) ::   ztnwtl, ztnetl, ztswtl, ztsetl   ! temporary 3D workspace 
     523      REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
     524      !!---------------------------------------------------------------------- 
     525 
     526      IF( kt == nit000 ) THEN 
     527         IF(lwp) WRITE(numout,*) 
     528         IF(lwp) WRITE(numout,*) 'dyn:vor_een_tam : vorticity term: energy and enstrophy conserving scheme' 
     529         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     530 
     531         DO jk = 1, jpk 
     532            DO jj = 1, jpjm1 
     533               DO ji = 1, jpim1 
     534                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     535                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25_wp 
     536                  IF( ze3f(ji,jj,jk) /= 0.0_wp )   ze3f(ji,jj,jk) = 1.0_wp / ze3f(ji,jj,jk) 
     537               END DO 
     538            END DO 
     539         END DO 
     540         CALL lbc_lnk( ze3f, 'F', 1._wp ) 
     541      ENDIF 
     542 
     543      ! Local constant initialization 
     544      zfac12 = 1.0_wp / 12.0_wp 
     545       
     546!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
     547      !                                                ! =============== 
     548      DO jk = 1, jpkm1                                 ! Horizontal slab 
     549         !                                             ! =============== 
     550          
     551         ! Potential vorticity and horizontal fluxes 
     552         ! ----------------------------------------- 
     553         SELECT CASE( kvor )      ! vorticity considered 
     554         CASE ( 1 )    
     555            zwz(:,:) = ff(:,:)      * ze3f(:,:,jk)   ! planetary vorticity (Coriolis) 
     556            zwztl(:,:) = 0.0_wp 
     557         CASE ( 2 )    
     558            zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk)   ! relative  vorticity 
     559            zwztl(:,:) = rotn_tl(:,:,jk) * ze3f(:,:,jk) 
     560         CASE ( 3 )                                                ! metric term 
     561            DO jj = 1, jpjm1 
     562               DO ji = 1, fs_jpim1   ! vector opt. 
     563                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     564                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     565                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     566               END DO 
     567            END DO 
     568            DO jj = 1, jpjm1 
     569               DO ji = 1, fs_jpim1   ! vector opt. 
     570                  zwztl(ji,jj) = (   ( vn_tl(ji+1,jj  ,jk) + vn_tl (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     571                       &         - ( un_tl(ji  ,jj+1,jk) + un_tl (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     572                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     573               END DO 
     574            END DO 
     575         CASE ( 4 )    
     576            zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) ! total (relative + planetary vorticity) 
     577            zwztl(:,:) = ( rotn_tl(:,:,jk) ) * ze3f(:,:,jk) 
     578         CASE ( 5 )                                                ! total (coriolis + metric) 
     579            DO jj = 1, jpjm1 
     580               DO ji = 1, fs_jpim1   ! vector opt. 
     581                  zwz(ji,jj) = ( ff (ji,jj)                                                                       & 
     582                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     583                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     584                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & 
     585                       &       ) * ze3f(ji,jj,jk) 
     586               END DO 
     587            END DO 
     588            DO jj = 1, jpjm1 
     589               DO ji = 1, fs_jpim1   ! vector opt. 
     590                  zwztl(ji,jj) = ( (   ( vn_tl(ji+1,jj  ,jk) + vn_tl (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     591                       &           - ( un_tl(ji  ,jj+1,jk) + un_tl (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     592                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               & 
     593                       &       ) * ze3f(ji,jj,jk) 
     594               END DO 
     595            END DO 
     596         END SELECT 
     597 
     598         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     599         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     600 
     601         zwxtl(:,:) = e2u(:,:) * fse3u(:,:,jk) * un_tl(:,:,jk) 
     602         zwytl(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn_tl(:,:,jk) 
     603 
     604         ! Compute and add the vorticity term trend 
     605         ! ---------------------------------------- 
     606         jj=2 
     607         ztne(1,:)   = 0.0_wp ; ztnw(1,:)   = 0.0_wp ; ztse(1,:)   = 0.0_wp ; ztsw(1,:)   = 0.0_wp 
     608         ztnetl(1,:) = 0.0_wp ; ztnwtl(1,:) = 0.0_wp ; ztsetl(1,:) = 0.0_wp ; ztswtl(1,:) = 0.0_wp 
     609         DO ji = 2, jpi    
     610               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     611               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     612               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     613               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     614 
     615               ztnetl(ji,jj) = zwztl(ji-1,jj  ) + zwztl(ji  ,jj  ) + zwztl(ji  ,jj-1) 
     616               ztnwtl(ji,jj) = zwztl(ji-1,jj-1) + zwztl(ji-1,jj  ) + zwztl(ji  ,jj  ) 
     617               ztsetl(ji,jj) = zwztl(ji  ,jj  ) + zwztl(ji  ,jj-1) + zwztl(ji-1,jj-1) 
     618               ztswtl(ji,jj) = zwztl(ji  ,jj-1) + zwztl(ji-1,jj-1) + zwztl(ji-1,jj  ) 
     619         END DO 
     620         DO jj = 3, jpj 
     621            DO ji = fs_2, jpi   ! vector opt. 
     622               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     623               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     624               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     625               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     626 
     627               ztnetl(ji,jj) = zwztl(ji-1,jj  ) + zwztl(ji  ,jj  ) + zwztl(ji  ,jj-1) 
     628               ztnwtl(ji,jj) = zwztl(ji-1,jj-1) + zwztl(ji-1,jj  ) + zwztl(ji  ,jj  ) 
     629               ztsetl(ji,jj) = zwztl(ji  ,jj  ) + zwztl(ji  ,jj-1) + zwztl(ji-1,jj-1) 
     630               ztswtl(ji,jj) = zwztl(ji  ,jj-1) + zwztl(ji-1,jj-1) + zwztl(ji-1,jj  ) 
     631            END DO 
     632         END DO 
     633         DO jj = 2, jpjm1 
     634            DO ji = fs_2, fs_jpim1   ! vector opt. 
     635               zuatl = + zfac12 / e1u(ji,jj) * (  ztnetl(ji,jj  ) * zwy(ji  ,jj  ) + ztne(ji,jj  ) * zwytl(ji  ,jj  )  & 
     636                  &                             + ztnwtl(ji+1,jj) * zwy(ji+1,jj  ) + ztnw(ji+1,jj) * zwytl(ji+1,jj  )  & 
     637                  &                             + ztsetl(ji,jj  ) * zwy(ji  ,jj-1) + ztse(ji,jj  ) * zwytl(ji  ,jj-1)    & 
     638                  &                             + ztswtl(ji+1,jj) * zwy(ji+1,jj-1) + ztsw(ji+1,jj) * zwytl(ji+1,jj-1)) 
     639 
     640               zvatl = - zfac12 / e2v(ji,jj) * (  ztswtl(ji,jj+1) * zwx(ji-1,jj+1) + ztsw(ji,jj+1) * zwxtl(ji-1,jj+1)  & 
     641                  &                           +   ztsetl(ji,jj+1) * zwx(ji  ,jj+1) + ztse(ji,jj+1) * zwxtl(ji  ,jj+1)   & 
     642                  &                           +   ztnwtl(ji,jj  ) * zwx(ji-1,jj  ) + ztnw(ji,jj  ) * zwxtl(ji-1,jj  )   & 
     643                  &                           +   ztnetl(ji,jj  ) * zwx(ji  ,jj  ) + ztne(ji,jj  ) * zwxtl(ji  ,jj  ) ) 
     644               pua_tl(ji,jj,jk) = pua_tl(ji,jj,jk) + zuatl 
     645               pva_tl(ji,jj,jk) = pva_tl(ji,jj,jk) + zvatl 
     646            END DO   
     647         END DO   
     648         !                                             ! =============== 
     649      END DO                                           !   End of slab 
     650      !                                                ! =============== 
     651   END SUBROUTINE vor_een_tan 
     652 
     653    
    342654   SUBROUTINE dyn_vor_adj( kt ) 
    343655      !!---------------------------------------------------------------------- 
    … …  
    360672      ! 
    361673      CASE ( -1 )                                      ! esopa: test all possibility with control print 
    362 !         CALL vor_een_adj( kt, ntot, ua_ad, va_ad ) 
     674         CALL vor_een_adj( kt, ntot, ua_ad, va_ad ) 
    363675!         CALL vor_mix_adj( kt ) 
    364676         CALL vor_ens_adj( kt, ntot, ua_ad, va_ad ) 
    … …  
    377689         ! 
    378690      CASE ( 3 )                                       ! energy and enstrophy conserving scheme 
    379          CALL ctl_stop ('vor_een_adj not available yet') 
    380 !         CALL vor_een_adj( kt, ntot, ua_ad, va_ad )                ! total vorticity 
     691         CALL vor_een_adj( kt, ntot, ua_ad, va_ad )                ! total vorticity 
    381692         ! 
    382693      END SELECT 
    … …  
    417728      !! 
    418729      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    419       REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
     730      REAL(wp) ::   zfact1               ! temporary scalars 
    420731      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz         ! temporary 3D workspace 
     732      REAL(wp) ::   zuav, zvau       ! temporary scalars 
    421733      REAL(wp) ::   zuavad, zvauad   ! temporary scalars 
    422734      REAL(wp), DIMENSION(jpi,jpj) ::   zwxad, zwyad, zwzad   ! temporary 3D workspace 
    … …  
    581893   END SUBROUTINE vor_ens_adj 
    582894 
     895 
     896   SUBROUTINE vor_een_adj( kt, kvor, pua_ad, pva_ad ) 
     897      !!---------------------------------------------------------------------- 
     898      !!                ***  ROUTINE vor_een_adj  *** 
     899      !! 
     900      !! ** Purpose :   Compute the now total vorticity trend and add it to  
     901      !!      the general trend of the momentum equation. 
     902      !! 
     903      !! ** Method  :   Trend evaluated using now fields (centered in time)  
     904      !!      and the Arakawa and Lamb (19XX) flux form formulation : conserves  
     905      !!      both the horizontal kinetic energy and the potential enstrophy 
     906      !!      when horizontal divergence is zero. 
     907      !!      The trend of the vorticity term is given by: 
     908      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 
     909      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 
     910      !!      Add this trend to the general momentum trend (ua,va): 
     911      !!          (ua,va) = (ua,va) + ( voru , vorv ) 
     912      !! 
     913      !! ** Action : - Update (ua,va) with the now vorticity term trend 
     914      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
     915      !!               and planetary vorticity trends) ('key_trddyn') 
     916      !! 
     917      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
     918      !!---------------------------------------------------------------------- 
     919      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
     920      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     921         !                                                        ! =nrvm (relative vorticity or metric) 
     922      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua_ad ! total u-trend 
     923      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva_ad ! total v-trend 
     924      !! 
     925      INTEGER ::   ji, jj, jk          ! dummy loop indices 
     926      REAL(wp) ::   zfac12             ! temporary scalars 
     927      REAL(wp) ::   zuaad, zvaad       ! temporary scalars 
     928      REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz                    ! temporary 2D workspace 
     929      REAL(wp), DIMENSION(jpi,jpj) ::   ztnw, ztne, ztsw, ztse           ! temporary 3D workspace 
     930      REAL(wp), DIMENSION(jpi,jpj) ::   zwxad, zwyad, zwzad              ! temporary 2D workspace 
     931      REAL(wp), DIMENSION(jpi,jpj) ::   ztnwad, ztnead, ztswad, ztsead   ! temporary 3D workspace 
     932      REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
     933      !!---------------------------------------------------------------------- 
     934 
     935      ! local adjoint initailization 
     936      zuaad = 0.0_wp ; zvaad = 0.0_wp 
     937      zwxad (:,:) = 0.0_wp ; zwyad (:,:) = 0.0_wp ; zwzad (:,:) = 0.0_wp 
     938      ztnwad(:,:) = 0.0_wp ; ztnead(:,:) = 0.0_wp ; ztswad(:,:) = 0.0_wp ; ztsead(:,:) = 0.0_wp 
     939 
     940      IF( kt == nitend ) THEN 
     941         IF(lwp) WRITE(numout,*) 
     942         IF(lwp) WRITE(numout,*) 'dyn:vor_een_adj : vorticity term: energy and enstrophy conserving scheme' 
     943         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     944 
     945         DO jk = 1, jpk 
     946            DO jj = 1, jpjm1 
     947               DO ji = 1, jpim1 
     948                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     949                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25_wp 
     950                  IF( ze3f(ji,jj,jk) /= 0.0_wp )   ze3f(ji,jj,jk) = 1.0_wp / ze3f(ji,jj,jk) 
     951               END DO 
     952            END DO 
     953         END DO 
     954         CALL lbc_lnk( ze3f, 'F', 1._wp ) 
     955      ENDIF 
     956 
     957      ! Local constant initialization 
     958      zfac12 = 1.0_wp / 12.0_wp 
     959    
     960!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
     961      !                                                ! =============== 
     962      DO jk = 1, jpkm1                                 ! Horizontal slab 
     963         !                                             ! =============== 
     964 
     965         ! Potential vorticity and horizontal fluxes  (Direct local variables init) 
     966         ! ----------------------------------------- 
     967         SELECT CASE( kvor )      ! vorticity considered 
     968         CASE ( 1 )   ;   zwz(:,:) =  ff(:,:) * ze3f(:,:,jk)      ! planetary vorticity (Coriolis) 
     969         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk) * ze3f(:,:,jk)                ! relative  vorticity 
     970         CASE ( 3 )                                                ! metric term 
     971            DO jj = 1, jpjm1 
     972               DO ji = 1, fs_jpim1   ! vector opt. 
     973                  zwz(ji,jj) = ( ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )  & 
     974                       &       - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) ) )& 
     975                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     976               END DO 
     977            END DO 
     978         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk)    ! total (relative + planetary vorticity) 
     979         CASE ( 5 )                                                ! total (coriolis + metric) 
     980            DO jj = 1, jpjm1 
     981               DO ji = 1, fs_jpim1   ! vector opt. 
     982                  zwz(ji,jj) = ( ff (ji,jj)                         & 
     983                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     984                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     985                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )  & 
     986                       &       ) * ze3f(ji,jj,jk) 
     987               END DO 
     988            END DO 
     989         END SELECT 
     990 
     991         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     992         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     993 
     994         ! Compute and add the vorticity term trend 
     995         ! ---------------------------------------- 
     996         jj=2 
     997         ztne(1,:)   = 0.0_wp ; ztnw(1,:)   = 0.0_wp ; ztse(1,:)   = 0.0_wp ; ztsw(1,:)   = 0.0_wp 
     998         DO ji = 2, jpi    
     999               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     1000               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     1001               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     1002               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     1003         END DO 
     1004         DO jj = 3, jpj 
     1005            DO ji = fs_2, jpi   ! vector opt. 
     1006               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     1007               ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     1008               ztse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     1009               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     1010            END DO 
     1011         END DO 
     1012 
     1013      ! =================== 
     1014      ! Adjoint counterpart 
     1015      ! =================== 
     1016 
     1017         DO jj = jpjm1, 2, -1 
     1018            DO ji = fs_jpim1, fs_2, -1   ! vector opt. 
     1019               zuaad = zuaad + pua_ad(ji,jj,jk) 
     1020               zvaad = zvaad + pva_ad(ji,jj,jk) 
     1021 
     1022               zvaad = - zvaad * zfac12 / e2v(ji,jj) 
     1023               ztswad(ji  ,jj+1) = ztswad(ji  ,jj+1) + zvaad * zwx (ji-1,jj+1) 
     1024               zwxad (ji-1,jj+1) = zwxad (ji-1,jj+1) + zvaad * ztsw(ji  ,jj+1) 
     1025               ztsead(ji  ,jj+1) = ztsead(ji  ,jj+1) + zvaad * zwx (ji  ,jj+1) 
     1026               zwxad (ji  ,jj+1) = zwxad (ji  ,jj+1) + zvaad * ztse(ji  ,jj+1) 
     1027               ztnwad(ji  ,jj  ) = ztnwad(ji  ,jj  ) + zvaad * zwx (ji-1,jj  ) 
     1028               zwxad (ji-1,jj  ) = zwxad (ji-1,jj  ) + zvaad * ztnw(ji  ,jj  ) 
     1029               ztnead(ji  ,jj  ) = ztnead(ji  ,jj  ) + zvaad * zwx (ji  ,jj  ) 
     1030               zwxad (ji  ,jj  ) = zwxad (ji  ,jj  ) + zvaad * ztne(ji  ,jj  ) 
     1031               zvaad = 0.0_wp 
     1032 
     1033               zuaad = zuaad * zfac12 / e1u(ji,jj) 
     1034               ztnead(ji  ,jj  ) = ztnead(ji  ,jj  ) + zuaad * zwy (ji  ,jj  ) 
     1035               zwyad (ji  ,jj  ) = zwyad (ji  ,jj  ) + zuaad * ztne(ji  ,jj  ) 
     1036               ztnwad(ji+1,jj  ) = ztnwad(ji+1,jj  ) + zuaad * zwy (ji+1,jj  ) 
     1037               zwyad (ji+1,jj  ) = zwyad (ji+1,jj  ) + zuaad * ztnw(ji+1,jj  ) 
     1038               ztsead(ji  ,jj  ) = ztsead(ji  ,jj  ) + zuaad * zwy (ji  ,jj-1) 
     1039               zwyad (ji  ,jj-1) = zwyad (ji  ,jj-1) + zuaad * ztse(ji  ,jj  ) 
     1040               ztswad(ji+1,jj  ) = ztswad(ji+1,jj  ) + zuaad * zwy (ji+1,jj-1) 
     1041               zwyad (ji+1,jj-1) = zwyad (ji+1,jj-1) + zuaad * ztsw(ji+1,jj  ) 
     1042               zuaad = 0.0_wp 
     1043            END DO   
     1044         END DO  
     1045         DO jj = jpj, 3, -1 
     1046            DO ji = jpi, fs_2, -1   ! vector opt. 
     1047               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztswad(ji,jj)  
     1048               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztswad(ji,jj) 
     1049               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztswad(ji,jj) 
     1050               ztswad(ji  ,jj  ) = 0.0_wp 
     1051               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztsead(ji,jj) 
     1052               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztsead(ji,jj) 
     1053               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztsead(ji,jj) 
     1054               ztsead(ji,jj)     = 0.0_wp 
     1055               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztnwad(ji,jj) 
     1056               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztnwad(ji,jj) 
     1057               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztnwad(ji,jj) 
     1058               ztnwad(ji  ,jj  ) = 0.0_wp 
     1059               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztnead(ji,jj) 
     1060               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztnead(ji,jj) 
     1061               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztnead(ji,jj) 
     1062               ztnead(ji,jj)     = 0.0_wp 
     1063            END DO 
     1064         END DO 
     1065         jj=2 
     1066         DO ji = jpi, 2, -1    
     1067               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztswad(ji,jj) 
     1068               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztswad(ji,jj) 
     1069               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztswad(ji,jj) 
     1070               ztswad(ji,jj) = 0.0_wp 
     1071               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztsead(ji,jj) 
     1072               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztsead(ji,jj) 
     1073               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztsead(ji,jj) 
     1074               ztsead(ji  ,jj  ) = 0.0_wp 
     1075               zwzad (ji-1,jj-1) = zwzad(ji-1,jj-1) + ztnwad(ji,jj) 
     1076               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztnwad(ji,jj) 
     1077               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztnwad(ji,jj) 
     1078               ztnwad(ji  ,jj ) = 0.0_wp 
     1079               zwzad (ji-1,jj  ) = zwzad(ji-1,jj  ) + ztnead(ji,jj) 
     1080               zwzad (ji  ,jj  ) = zwzad(ji  ,jj  ) + ztnead(ji,jj) 
     1081               zwzad (ji  ,jj-1) = zwzad(ji  ,jj-1) + ztnead(ji,jj) 
     1082               ztnead(ji  ,jj  ) = 0.0_wp 
     1083         END DO 
     1084         ztnead(1,:)   = 0.0_wp ; ztnwad(1,:)   = 0.0_wp  
     1085         ztsead(1,:)   = 0.0_wp ; ztswad(1,:)   = 0.0_wp 
     1086 
     1087         vn_ad(:,:,jk) = vn_ad(:,:,jk) + zwyad(:,:) * e1v(:,:) * fse3v(:,:,jk) 
     1088         un_ad(:,:,jk) = un_ad(:,:,jk) + zwxad(:,:) * e2u(:,:) * fse3u(:,:,jk) 
     1089         zwyad(:,:)    = 0.0_wp 
     1090         zwxad(:,:)    = 0.0_wp 
     1091 
     1092         ! Potential vorticity and horizontal fluxes 
     1093         ! ----------------------------------------- 
     1094         SELECT CASE( kvor )      ! vorticity considered 
     1095         CASE ( 1 )    
     1096            zwzad(:,:) = 0.0_wp 
     1097         CASE ( 2 )    
     1098            rotn_ad(:,:,jk) = rotn_ad(:,:,jk) +  zwzad(:,:) * ze3f(:,:,jk) 
     1099            zwzad(:,:)      = 0.0_wp 
     1100         CASE ( 3 )                                                ! metric term 
     1101            DO jj = jpjm1, 1, -1 
     1102               DO ji = fs_jpim1, 1, -1   ! vector opt. 
     1103                  zwzad(ji  ,jj     ) = zwzad(ji,jj) * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     1104                  vn_ad(ji+1,jj  ,jk) =   vn_ad(ji+1,jj  ,jk) + zwzad(ji,jj) * ( e2v(ji+1,jj  ) - e2v(ji,jj) ) 
     1105                  vn_ad(ji  ,jj  ,jk) =   vn_ad(ji  ,jj  ,jk) + zwzad(ji,jj) * ( e2v(ji+1,jj  ) - e2v(ji,jj) ) 
     1106                  un_ad(ji  ,jj+1,jk) = - un_ad(ji  ,jj+1,jk) + zwzad(ji,jj) * ( e1u(ji  ,jj+1) - e1u(ji,jj) ) 
     1107                  un_ad(ji  ,jj  ,jk) = - un_ad(ji  ,jj  ,jk) + zwzad(ji,jj) * ( e1u(ji  ,jj+1) - e1u(ji,jj) ) 
     1108                  zwzad(ji  ,jj     ) = 0.0_wp 
     1109               END DO 
     1110            END DO 
     1111         CASE ( 4 )    
     1112            rotn_ad(:,:,jk) = rotn_ad(:,:,jk) + zwzad(:,:) * ze3f(:,:,jk) 
     1113            zwzad(:,:) = 0.0_wp 
     1114         CASE ( 5 )                                                ! total (coriolis + metric) 
     1115            DO jj = jpjm1, 1, -1 
     1116               DO ji = fs_jpim1, 1, -1   ! vector opt. 
     1117                  zwzad(ji  ,jj     ) = zwzad(ji,jj) * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     1118 
     1119                  vn_ad(ji+1,jj  ,jk) = vn_ad(ji+1,jj  ,jk) + zwzad(ji,jj) * ( e2v(ji+1,jj  ) - e2v(ji,jj) ) 
     1120                  vn_tl(ji  ,jj  ,jk) = vn_tl(ji  ,jj  ,jk) + zwzad(ji,jj) * ( e2v(ji+1,jj  ) - e2v(ji,jj) ) 
     1121                  un_ad(ji  ,jj+1,jk) = un_ad(ji  ,jj+1,jk) - zwzad(ji,jj) * ( e1u(ji  ,jj+1) - e1u(ji,jj) ) 
     1122                  un_ad(ji  ,jj  ,jk) = un_ad(ji  ,jj  ,jk) - zwzad(ji,jj) * ( e1u(ji  ,jj+1) - e1u(ji,jj) ) 
     1123 
     1124                  zwzad(ji  ,jj     ) = 0.0_wp 
     1125               END DO 
     1126            END DO 
     1127         END SELECT 
     1128         !                                             ! =============== 
     1129      END DO                                           !   End of slab 
     1130      !                                                ! =============== 
     1131   END SUBROUTINE vor_een_adj 
     1132 
    5831133   SUBROUTINE vor_ctl_tam 
    5841134      !!--------------------------------------------------------------------- 
    … …  
    5991149         WRITE(numout,*) 'dyn:vor_ctl_tam : vorticity term : read namelist and control the consistency' 
    6001150         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    601          WRITE(numout,*) '        Namelist nam_dynvor : oice of the vorticity term scheme' 
     1151         WRITE(numout,*) '        Namelist nam_dynvor : choice of the vorticity term scheme' 
    6021152         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene 
    6031153         WRITE(numout,*) '           enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens 
    … …  
    6791229         & ji,    &        ! dummy loop indices 
    6801230         & jj,    &         
    681          & jk      
     1231         & jk,    & 
     1232         & jt      
    6821233      INTEGER, DIMENSION(jpi,jpj) :: & 
    6831234         & iseed_2d        ! 2D seed for the random number generator 
    … …  
    7381289         & ) 
    7391290 
     1291      ! init ntot parameter 
     1292      CALL vor_ctl_tam          ! initialisation & control of options 
     1293 
     1294      DO jt = 1, 2 
     1295         IF (jt == 1) nvor=1 ! enstrophy conserving scheme 
     1296         IF (jt == 2) nvor=3 ! energy and enstrophy conserving scheme 
     1297 
    7401298      ! Initialize rotn 
    7411299      CALL div_cur ( nit000 ) 
    … …  
    8161374      END DO 
    8171375      CALL grid_random( iseed_2d, zav, 'V', 0.0_wp, stdv ) 
    818 !zun_tlin(:,:,:) = znu(:,:,:)  
    819 !zvn_tlin(:,:,:) = znv(:,:,:)  
    820 !zua_tlin(:,:,:) = zau(:,:,:)  
    821 !zva_tlin(:,:,:) = zav(:,:,:) 
     1376 
    8221377      DO jk = 1, jpk 
    8231378         DO jj = nldj, nlej 
    … …  
    8371392      ! initialize rotn_tl with noise 
    8381393      CALL div_cur_tan ( nit000 ) 
    839 !zrotn_tlin(:,:,:) = rotn_tl(:,:,:) 
     1394 
    8401395      DO jk = 1, jpk 
    8411396        DO jj = nldj, nlej 
    … …  
    8471402      rotn_tl(:,:,:) = zrotn_tlin(:,:,:) 
    8481403 
    849       CALL dyn_vor_tan( nit000 ) 
     1404 
     1405         IF (nvor == 1 )  CALL vor_ens_tan( nit000, ntot, ua_tl, va_tl ) 
     1406         IF (nvor == 3 )  CALL vor_een_tan( nit000, ntot, ua_tl, va_tl ) 
    8501407      zua_tlout(:,:,:) = ua_tl(:,:,:) 
    8511408      zva_tlout(:,:,:) = va_tl(:,:,:) 
    … …  
    8821439      va_ad(:,:,:) = zva_adin(:,:,:) 
    8831440 
    884       CALL dyn_vor_adj ( nitend ) 
    885  
     1441 
     1442         IF (nvor == 1 )  CALL vor_ens_adj( nitend, ntot, ua_ad, va_ad ) 
     1443         IF (nvor == 3 )  CALL vor_een_adj( nitend, ntot, ua_ad, va_ad ) 
    8861444      zun_adout(:,:,:)   = un_ad(:,:,:) 
    8871445      zvn_adout(:,:,:)   = vn_ad(:,:,:) 
    … …  
    9001458 
    9011459      ! 14 char:'12345678901234' 
    902       cl_name = 'dyn_vor_adj   ' 
     1460         IF (nvor == 1 )  cl_name = 'dynvor_adj ens' 
     1461         IF (nvor == 3 )  cl_name = 'dynvor_adj een' 
     1462 
    9031463      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 
     1464      END DO 
    9041465 
    9051466      DEALLOCATE( & 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynzad_tam.F90

    r1885 r2587  
    131131      DO jj = 2, jpjm1              ! Surface and bottom values set to zero 
    132132         DO ji = fs_2, fs_jpim1           ! vector opt. 
    133             zwuwtl(ji,jj, 1 ) = 0.e0 
    134             zwvwtl(ji,jj, 1 ) = 0.e0 
    135             zwuwtl(ji,jj,jpk) = 0.e0 
    136             zwvwtl(ji,jj,jpk) = 0.e0 
     133            zwuwtl(ji,jj, 1 ) = 0.0_wp 
     134            zwvwtl(ji,jj, 1 ) = 0.0_wp 
     135            zwuwtl(ji,jj,jpk) = 0.0_wp 
     136            zwvwtl(ji,jj,jpk) = 0.0_wp 
    137137         END DO 
    138138      END DO 
    … …  
    210210         END DO 
    211211      END DO 
     212      DO jj = 2, jpjm1              ! Surface and bottom values set to zero 
     213         DO ji = fs_2, fs_jpim1           ! vector opt. 
     214            zwuwad(ji,jj, 1 ) = 0.0_wp 
     215            zwvwad(ji,jj, 1 ) = 0.0_wp 
     216            zwuwad(ji,jj,jpk) = 0.0_wp 
     217            zwvwad(ji,jj,jpk) = 0.0_wp 
     218         END DO 
     219      END DO 
    212220      DO jk = jpkm1, 2, -1             ! Vertical momentum advection at level w and u- and v- vertical 
    213221         DO jj = 2, jpj                   ! vertical fluxes  

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynzdf_exp_tam.F90

    r1885 r2587  
    2020   !! * Modules used 
    2121 
    22    USE in_out_manager  ! I/O manager 
     22   USE par_kind      , ONLY: & ! Precision variables 
     23      & wp 
     24   USE par_oce       , ONLY: & ! Ocean space and time domain variables 
     25      & jpi,                 & 
     26      & jpj,                 &  
     27      & jpk,                 &  
     28      & jpim1,               & 
     29      & jpjm1,               &  
     30      & jpkm1 
     31   USE oce_tam       , ONLY: & ! ocean dynamics and tracers 
     32      & ub_tl,               & 
     33      & vb_tl,               & 
     34      & ua_tl,               & 
     35      & va_tl,               & 
     36      & ub_ad,               & 
     37      & vb_ad,               & 
     38      & ua_ad,               & 
     39      & va_ad 
     40   USE zdf_oce       , ONLY: & ! ocean vertical physics 
     41      & avmu,                & 
     42      & avmv,                & 
     43      & n_zdfexp 
     44   USE dom_oce       , ONLY: & ! ocean space and time domain 
     45#if defined key_zco 
     46      & e3t_0,               & 
     47      & e3w_0,               & 
     48#else 
     49      & e3u,                 & 
     50      & e3v,                 & 
     51      & e3uw,                & 
     52      & e3vw,                & 
     53#endif 
     54      & umask,               & 
     55      & vmask 
     56   USE phycst        , ONLY: & ! physical constants 
     57      & rau0 
     58   USE in_out_manager, ONLY: & ! I/O manager 
     59      & nit000,              & 
     60      & nitend,              & 
     61      & numout,              & 
     62      & lwp,                 & 
     63      & ctl_stop 
    2364   IMPLICIT NONE 
    2465   PRIVATE 
    … …  
    59100      !! * Local declarations 
    60101      INTEGER ::   ji, jj, jk, jl                              ! dummy loop indices 
    61       REAL(wp) ::   zrau0r, zlavmr, zua, zva                   ! temporary scalars 
    62       REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww     ! temporary workspace arrays 
     102      REAL(wp) ::   zrau0r, zlavmr, zuatl, zvatl                   ! temporary scalars 
     103      REAL(wp), DIMENSION(jpi,jpk) ::   zwxtl, zwytl, zwztl, zwwtl     ! temporary workspace arrays 
    63104      !!---------------------------------------------------------------------- 
    64105 
    … …  
    68109         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 
    69110      ENDIF 
    70  
    71       CALL ctl_stop ('dyn_zdf_exp_tan not available yet') 
     111      ! Local constant initialization 
     112      ! ----------------------------- 
     113      zrau0r = 1. / rau0                                   ! inverse of the reference density 
     114      zlavmr = 1. / float( n_zdfexp )                      ! inverse of the number of sub time step 
     115 
     116      !                                                ! =============== 
     117      DO jj = 2, jpjm1                                 !  Vertical slab 
     118         !                                             ! =============== 
     119 
     120         ! Surface boundary condition 
     121         DO ji = 2, jpim1 
     122            zwytl(ji,1) = 0.0_wp 
     123            zwwtl(ji,1) = 0.0_wp 
     124         END DO   
     125 
     126         ! Initialization of x, z and contingently trends array 
     127         DO jk = 1, jpk 
     128            DO ji = 2, jpim1 
     129               zwxtl(ji,jk) = ub_tl(ji,jj,jk) 
     130               zwztl(ji,jk) = vb_tl(ji,jj,jk) 
     131            END DO   
     132         END DO   
     133 
     134         ! Time splitting loop 
     135         DO jl = 1, n_zdfexp 
     136 
     137            ! First vertical derivative 
     138            DO jk = 2, jpk 
     139               DO ji = 2, jpim1 
     140                  zwytl(ji,jk) = avmu(ji,jj,jk) * ( zwxtl(ji,jk-1) - zwxtl(ji,jk) ) / fse3uw(ji,jj,jk)  
     141                  zwwtl(ji,jk) = avmv(ji,jj,jk) * ( zwztl(ji,jk-1) - zwztl(ji,jk) ) / fse3vw(ji,jj,jk) 
     142               END DO   
     143            END DO   
     144 
     145            ! Second vertical derivative and trend estimation at kt+l*rdt/n_zdfexp 
     146            DO jk = 1, jpkm1 
     147               DO ji = 2, jpim1 
     148                  zuatl = zlavmr*( zwytl(ji,jk) - zwytl(ji,jk+1) ) / fse3u(ji,jj,jk) 
     149                  zvatl = zlavmr*( zwwtl(ji,jk) - zwwtl(ji,jk+1) ) / fse3v(ji,jj,jk) 
     150                  ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) + zuatl 
     151                  va_tl(ji,jj,jk) = va_tl(ji,jj,jk) + zvatl 
     152 
     153                  zwxtl(ji,jk) = zwxtl(ji,jk) + p2dt*zuatl*umask(ji,jj,jk) 
     154                  zwztl(ji,jk) = zwztl(ji,jk) + p2dt*zvatl*vmask(ji,jj,jk) 
     155               END DO   
     156            END DO   
     157 
     158         END DO   
     159 
     160         !                                             ! =============== 
     161      END DO                                           !   End of slab 
     162      !                                                ! =============== 
     163 
     164 
    72165   END SUBROUTINE dyn_zdf_exp_tan 
    73166   SUBROUTINE dyn_zdf_exp_adj( kt, p2dt ) 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/DYN/dynzdf_imp_tam.F90

    r1885 r2587  
    126126            DO ji = fs_2, fs_jpim1   ! vector opt. 
    127127               zcoef = - p2dt / fse3u(ji,jj,jk) 
    128                zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  ) 
     128               zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  ) * umask(ji,jj,jk) 
    129129               zzws          = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 
    130130               zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1) 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SBC/sbc_oce_tam.F90

    r1885 r2587  
    2828   PUBLIC & 
    2929      & sbc_oce_tam_init, & !: Initialize the TAM fields 
     30      & sbc_oce_tam_deallocate, & !: Deallocate the TAM fields 
    3031   !!---------------------------------------------------------------------- 
    3132   !!              Ocean Surface Boundary Condition fields 
    … …  
    295296 
    296297   END SUBROUTINE sbc_oce_tam_init 
     298   SUBROUTINE sbc_oce_tam_deallocate( kindic ) 
     299      !!----------------------------------------------------------------------- 
     300      !! 
     301      !!                  ***  ROUTINE sbc_oce_tam_init  *** 
     302      !! 
     303      !! ** Purpose : Allocate and initialize the tangent linear and  
     304      !!              adjoint arrays 
     305      !! 
     306      !! ** Method  : kindic = 0  deallocate both tl and ad variables 
     307      !!              kindic = 1  deallocate only tl variables 
     308      !!              kindic = 2  deallocate only ad variables 
     309      !! 
     310      !! ** Action  : 
     311      !!                    
     312      !! References :  
     313      !! 
     314      !! History : 
     315      !!        ! 2010-06 (A. Vidard) Initial version  
     316      !!----------------------------------------------------------------------- 
     317      !! * Arguments 
     318      INTEGER, INTENT(IN) :: & 
     319         & kindic        ! indicate which variables to deallocate 
     320 
     321      !! * Local declarations 
     322       
     323      ! Deallocate tangent linear variable arrays 
     324      ! --------------------------------------- 
     325       
     326      IF ( kindic == 0 .OR. kindic == 1 ) THEN 
     327 
     328         IF ( ALLOCATED(utau_tl) )    DEALLOCATE( utau_tl ) 
     329         IF ( ALLOCATED(vtau_tl) )    DEALLOCATE( vtau_tl ) 
     330         IF ( ALLOCATED(wndm_tl) )    DEALLOCATE( wndm_tl ) 
     331         IF ( ALLOCATED(qns_tl) )     DEALLOCATE( qns_tl ) 
     332         IF ( ALLOCATED(qsr_tl) )     DEALLOCATE( qsr_tl ) 
     333         IF ( ALLOCATED(emp_tl) )     DEALLOCATE( emp_tl ) 
     334         IF ( ALLOCATED(emps_tl) )    DEALLOCATE( emps_tl ) 
     335         IF ( ALLOCATED(fr_i_tl) )    DEALLOCATE( fr_i_tl ) 
     336         IF ( ALLOCATED(ssu_m_tl) )   DEALLOCATE( ssu_m_tl ) 
     337         IF ( ALLOCATED(ssv_m_tl) )   DEALLOCATE( ssv_m_tl ) 
     338         IF ( ALLOCATED(sst_m_tl) )   DEALLOCATE( sst_m_tl ) 
     339         IF ( ALLOCATED(sss_m_tl) )   DEALLOCATE( sss_m_tl ) 
     340 
     341 
     342      ENDIF 
     343 
     344      IF ( kindic == 0 .OR. kindic == 2 ) THEN 
     345 
     346         ! Deallocate adjoint variable arrays 
     347         ! -------------------------------- 
     348       
     349         IF ( ALLOCATED(utau_ad) )    DEALLOCATE( utau_ad ) 
     350         IF ( ALLOCATED(vtau_ad) )    DEALLOCATE( vtau_ad ) 
     351         IF ( ALLOCATED(wndm_ad) )    DEALLOCATE( wndm_ad ) 
     352         IF ( ALLOCATED(qns_ad) )     DEALLOCATE( qns_ad ) 
     353         IF ( ALLOCATED(qsr_ad) )     DEALLOCATE( qsr_ad ) 
     354         IF ( ALLOCATED(emp_ad) )     DEALLOCATE( emp_ad ) 
     355         IF ( ALLOCATED(emps_ad) )    DEALLOCATE( emps_ad ) 
     356         IF ( ALLOCATED(fr_i_ad) )    DEALLOCATE( fr_i_ad ) 
     357         IF ( ALLOCATED(ssu_m_ad) )   DEALLOCATE( ssu_m_ad ) 
     358         IF ( ALLOCATED(ssv_m_ad) )   DEALLOCATE( ssv_m_ad ) 
     359         IF ( ALLOCATED(sst_m_ad) )   DEALLOCATE( sst_m_ad ) 
     360         IF ( ALLOCATED(sss_m_ad) )   DEALLOCATE( sss_m_ad ) 
     361          
     362      ENDIF 
     363 
     364   END SUBROUTINE sbc_oce_tam_deallocate 
    297365#endif 
    298366 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SOL/sol_oce_tam.F90

    r1885 r2587  
    3131      & nmax_fs 
    3232!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     33   USE sol_oce       , ONLY: & 
     34      & nmin 
     35#if defined key_dynspg_flt 
    3336   USE solver        , ONLY: & ! Solver 
    3437      & solver_init 
    35  
     38#endif 
    3639   !! * Routine accessibility 
    3740    
    … …  
    4144   PUBLIC & 
    4245      & sol_oce_tam_init, & !: routine called by nemovar.F90 
     46      & sol_oce_tam_deallocate, & 
    4347                    ! 
    4448      & gcx_tl,   & !: Tangent of now solution of the elliptic equation 
    … …  
    4852      & gcx_ad,   & !: Adjoint of solution of the elliptic equation 
    4953      & gcxb_ad,  & !: Adjoint of before solution of the elliptic equation 
    50       & gcb_ad     !: Adjoint of 2nd member of barotropic linear system 
    51  
     54      & gcb_ad ,  & !: Adjoint of 2nd member of barotropic linear system 
     55      & nitsor 
    5256   !! * Module variables 
    5357   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    … …  
    8993         & kindic        ! indicate which variables to allocate/initialize 
    9094 
     95#if defined key_dynspg_flt 
    9196      IF ( kindic == 0 .OR. kindic == 1 ) THEN 
    9297 
     98         IF ( kindic == 0 ) CALL solver_init( nit000 ) 
     99 
    93100         IF ( .NOT. ALLOCATED(nitsor) ) THEN 
    94101 
    95102            ALLOCATE( nitsor( nitend - nit000 + 1 ) ) 
    96  
    97          ENDIF 
    98  
    99          nitsor(:) = nmax_fs 
    100  
    101       IF ( kindic == 0 ) CALL solver_init( nit000 ) 
     103            nitsor(:) = nmin 
     104 
     105         ENDIF 
     106 
    102107 
    103108      ENDIF 
    … …  
    162167 
    163168      ENDIF 
    164  
     169#endif 
    165170   END SUBROUTINE sol_oce_tam_init 
    166  
     171   SUBROUTINE sol_oce_tam_deallocate(kindic) 
     172      !!----------------------------------------------------------------------- 
     173      !! 
     174      !!                  ***  ROUTINE sol_oce_tam_deallocate  *** 
     175      !! 
     176      !! ** Purpose :  
     177      !! 
     178      !! ** Method  : kindic = 0  deallocate both tl and ad variables 
     179      !!              kindic = 1  deallocate only tl variables 
     180      !!              kindic = 2  deallocate only ad variables 
     181      !! 
     182      !! ** Action  : 
     183      !!                    
     184      !! References :  
     185      !! 
     186      !! History : 
     187      !!         ! 2010-06 (A. Vidard) Initial version 
     188      !!----------------------------------------------------------------------- 
     189      !! * Arguments 
     190      INTEGER, INTENT(IN) :: & 
     191         & kindic        ! indicate which variables to allocate/initialize 
     192#if defined key_dynspg_flt 
     193      IF ( kindic == 0 ) THEN 
     194         IF ( ALLOCATED(nitsor) )  DEALLOCATE( nitsor ) 
     195      END IF 
     196 
     197      IF ( kindic == 0 .OR. kindic == 1 ) THEN 
     198 
     199         IF ( ALLOCATED(gcx_tl) )  DEALLOCATE( gcx_tl  ) 
     200 
     201         IF ( ALLOCATED(gcxb_tl) ) DEALLOCATE( gcxb_tl ) 
     202 
     203         IF ( ALLOCATED(gcb_tl) )  DEALLOCATE( gcb_tl  ) 
     204 
     205         IF ( ALLOCATED(gcr_tl) )  DEALLOCATE( gcr_tl  ) 
     206 
     207      ENDIF 
     208 
     209      IF ( kindic == 0 .OR. kindic == 2 ) THEN 
     210 
     211         IF ( ALLOCATED(gcx_ad) )  DEALLOCATE( gcx_ad  ) 
     212 
     213         IF ( ALLOCATED(gcxb_ad) ) DEALLOCATE( gcxb_ad ) 
     214 
     215         IF ( ALLOCATED(gcb_ad) )  DEALLOCATE( gcb_ad  ) 
     216 
     217      ENDIF 
     218       
     219#endif 
     220   END SUBROUTINE sol_oce_tam_deallocate 
    167221END MODULE sol_oce_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SOL/solsor_tam.F90

    r1885 r2587  
    1919      & jpiglo 
    2020   USE in_out_manager, ONLY: & ! I/O manager  
    21       & nit000 
     21      & nit000, lwp 
    2222   USE sol_oce       , ONLY: & ! solver variables 
    2323      & gcdmat,              & 
    … …  
    7171   USE tstool_tam    , ONLY: & 
    7272      & prntst_adj,          & 
    73       & stdgc 
     73      & stdgc,               & 
     74      & prntst_tlm 
    7475    
    7576 
    … …  
    8081   PUBLIC sol_sor_adj          !  
    8182   PUBLIC sol_sor_tan          !  
    82    PUBLIC sol_sor_adj_tst      ! called by tst.F90 
    83  
     83   PUBLIC sol_sor_adj_tst      ! called by tamtst.F90 
     84#if defined key_tst_tlm 
     85   PUBLIC sol_sor_tlm_tst      ! called by tamtst.F90 
     86#endif 
    8487 
    8588CONTAINS 
    … …  
    194197       
    195198         ! test of convergence 
    196          IF ( jn > nmin .AND. MOD( jn-nmin, nmod ) == 0 ) THEN 
     199         IF ( (jn > nmin .AND. MOD( jn-nmin, nmod ) == 0) .OR. jn==nmax) THEN 
    197200 
    198201            SELECT CASE ( nsol_arp ) 
    … …  
    232235         ENDIF 
    233236         ! indicator of non-convergence or explosion 
     237        IF( jn == nmax ) nitsor(istp) = jn 
    234238         IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
    235239         IF( ncut == 999 ) GOTO 999 
    … …  
    318322      ijmppodd  = MOD(nimpp+njmpp+jpr2di+jpr2dj+1,2) 
    319323      ijpr2d = MAX(jpr2di,jpr2dj) 
    320       icount = 0 
    321324 
    322325      ! Fixed number of iterations 
    323326      istp = kt - nit000 + 1 
    324327      iter = nitsor(istp) 
    325  
     328      icount = iter * 2 
    326329      !  Output in gcx_ad 
    327330      !  ---------------- 
    … …  
    330333 
    331334      !                                                    ! ============== 
    332       DO jn = 1, iter                                      ! Iterative loop  
     335      DO jn = iter, 1, -1                                  ! Iterative loop  
    333336         !                                                 ! ============== 
    334337         ! Guess red update 
    … …  
    349352            END DO 
    350353         END DO 
    351          icount = icount + 1  
    352           
     354        icount = icount - 1          
    353355         ! applied the lateral boundary conditions 
    354356         IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e_adj( gcx_ad, c_solver_pt, 1.0_wp )   ! Lateral BCs 
    … …  
    375377         END DO 
    376378 
    377          icount = icount + 1  
    378   
     379        icount = icount - 1  
    379380         ! applied the lateral boundary conditions 
    380381         IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e_adj( gcx_ad, c_solver_pt, 1.0_wp )   ! Lateral BCs 
    … …  
    418419         & jk,    &         
    419420         & kindic,&        ! flags fo solver convergence 
     421         & kmod,  &        ! frequency of test for the SOR solver 
    420422         & kt              ! number of iteration 
    421423      INTEGER, DIMENSION(jpi,jpj) :: & 
    … …  
    465467 
    466468      kt=nit000 
     469      kindic=0 
     470!      kmod = nmod  ! store frequency of test for the SOR solver 
     471!      nmod = 1     ! force frequency to one (remove adj_tst dependancy to nn_nmin) 
    467472          
    468  
    469473      DO jj = 1, jpj 
    470474         DO ji = 1, jpi 
    … …  
    491495         END DO 
    492496      END DO 
    493  
     497      ncut = 1 ! reinitilize the solver convergence flag 
     498      gcr_tl(:,:) = 0.0_wp 
    494499      gcb_tl(:,:) = zgcb_tlin(:,:) 
    495500      gcx_tl(:,:) = zgcx_tlin(:,:) 
    … …  
    502507      !-------------------------------------------------------------------- 
    503508 
    504       DO jk = 1, jpk 
    505509        DO jj = nldj, nlej 
    506510           DO ji = nldi, nlei 
    … …  
    510514            END DO 
    511515         END DO 
    512       END DO 
    513516      !-------------------------------------------------------------------- 
    514517      ! Compute the scalar product: ( L dx )^T W dy 
    … …  
    520523      ! Call the adjoint routine: dx^* = L^T dy^* 
    521524      !-------------------------------------------------------------------- 
    522  
     525      gcb_ad(:,:) = 0.0_wp 
    523526      gcx_ad(:,:) = zgcx_adin(:,:) 
    524527      CALL sol_sor_adj(kt, kindic)  
    … …  
    533536      cl_name = 'sol_sor_adj   ' 
    534537      CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 
     538 
     539!      nmod = kmod  ! restore initial frequency of test for the SOR solver 
    535540 
    536541      DEALLOCATE(      & 
    … …  
    547552 
    548553   END SUBROUTINE sol_sor_adj_tst 
     554#if defined key_tst_tlm 
     555   SUBROUTINE sol_sor_tlm_tst( kumadt ) 
     556      !!----------------------------------------------------------------------- 
     557      !! 
     558      !!                  ***  ROUTINE example_adj_tst *** 
     559      !! 
     560      !! ** Purpose : Test the tangent routine. 
     561      !! 
     562      !! ** Method  : Verify the tangent with Taylor expansion  
     563      !!            
     564      !!                 M(x+hdx) = M(x) + L(hdx) + O(h^2) 
     565      !! 
     566      !!              where  L   = tangent routine 
     567      !!                     M   = direct routine 
     568      !!                     dx  = input perturbation (random field) 
     569      !!                     h   = ration on perturbation  
     570      !!    
     571      !!    In the tangent test we verify that: 
     572      !!                M(x+h*dx) - M(x) 
     573      !!        g(h) = ------------------ --->  1    as  h ---> 0 
     574      !!                    L(h*dx) 
     575      !!    and 
     576      !!                g(h) - 1 
     577      !!        f(h) = ----------         --->  k (costant) as  h ---> 0 
     578      !!                    p 
     579      !!                   
     580      !! History : 
     581      !!        ! 10-02 (A. Vigilant) 
     582      !!----------------------------------------------------------------------- 
     583#if defined key_tam 
     584      !! * Modules used 
     585      USE solsor             ! Red-Black Successive Over-Relaxation solver 
     586      USE tamtrj              ! writing out state trajectory 
     587      USE par_tlm,    ONLY: & 
     588        & tlm_bch,          & 
     589        & cur_loop,         & 
     590        & h_ratio 
     591      USE istate_mod 
     592      USE wzvmod             !  vertical velocity 
     593      USE gridrandom, ONLY: & 
     594        & grid_rd_sd 
     595      USE trj_tam 
     596      USE sol_oce           , ONLY: & ! ocean dynamics and tracers variables 
     597        & gcb, gcx, ncut 
     598      USE oce       , ONLY: & !  
     599        & ua, ub, un 
     600      USE opatam_tst_ini, ONLY: & 
     601       & tlm_namrd 
     602      USE tamctl,         ONLY: & ! Control parameters 
     603       & numtan, numtan_sc 
     604      !! * Arguments 
     605      INTEGER, INTENT(IN) :: & 
     606         & kumadt             ! Output unit 
    549607    
     608      !! * Local declarations 
     609      INTEGER ::  & 
     610         & ji,    &        ! dummy loop indices 
     611         & jj,    &         
     612         & jk,    &         
     613         & kindic,&        ! flags fo solver convergence 
     614         & kt              ! number of iteration 
     615      INTEGER, DIMENSION(jpi,jpj) :: & 
     616         & iseed_2d        ! 2D seed for the random number generator 
     617      REAL(KIND=wp) ::   & 
     618         & zsp1, zsp2, zsp3, & ! scalar product 
     619         & zsp_gcb, zsp_gcx, & 
     620         & zsp,         & 
     621         & gamma,        & 
     622         & zgsp1,        & 
     623         & zgsp2,        & 
     624         & zgsp3,        & 
     625         & zgsp4,        & 
     626         & zgsp5,        & 
     627         & zgsp6,        & 
     628         & zgsp7 
     629      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 
     630         & zgcb_tlin ,     & ! Tangent input 
     631         & zgcx_tlin ,     & ! Tangent input 
     632         & zgcb_out  ,     & ! Direct output 
     633         & zgcx_out  ,     & ! Direct output 
     634         & zgcb_wop  ,     & ! Direct output without perturbation 
     635         & zgcx_wop  ,     & ! Direct output without perturbation 
     636         & zr             ! 3D random field  
     637      CHARACTER(LEN=14) :: cl_name 
     638      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
     639      CHARACTER (LEN=90)  :: FMT 
     640      REAL(KIND=wp), DIMENSION(100):: & 
     641         & zscgcb,zscgcx,             & 
     642         & zscerrgcb, zscerrgcx 
     643      INTEGER, DIMENSION(100)::       & 
     644         & iiposgcb, ijposgcb,          & 
     645         & iiposgcx, ijposgcx 
     646      INTEGER::             & 
     647         & ii,              & 
     648         & isamp=40,        & 
     649         & jsamp=40,        & 
     650         & numsctlm 
     651     REAL(KIND=wp), DIMENSION(jpi,jpj) :: & 
     652         & zerrgcb, zerrgcx 
     653 
     654      ! Allocate memory 
     655 
     656      ALLOCATE( & 
     657         & zgcb_tlin( jpi,jpj),     & 
     658         & zgcx_tlin( jpi,jpj),     & 
     659         & zgcb_out ( jpi,jpj),     & 
     660         & zgcx_out ( jpi,jpj),     & 
     661         & zgcb_wop ( jpi,jpj),     & 
     662         & zgcx_wop ( jpi,jpj),     & 
     663         & zr(        jpi,jpj)      & 
     664         & ) 
     665      !================================================================== 
     666      ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and  
     667      !    dy = ( hdivb_tl, hdivn_tl ) 
     668      !================================================================== 
     669 
     670      !-------------------------------------------------------------------- 
     671      ! Reset the tangent and adjoint variables 
     672      !-------------------------------------------------------------------- 
     673      zgcb_tlin( :,:) = 0.0_wp 
     674      zgcx_tlin( :,:) = 0.0_wp 
     675      zgcb_out ( :,:) = 0.0_wp 
     676      zgcx_out ( :,:) = 0.0_wp 
     677      zgcb_wop ( :,:) = 0.0_wp 
     678      zgcx_wop ( :,:) = 0.0_wp 
     679      zr(        :,:) = 0.0_wp 
     680 
     681      !-------------------------------------------------------------------- 
     682      ! Initialize the tangent input with random noise: dx 
     683      !-------------------------------------------------------------------- 
     684 
     685      !-------------------------------------------------------------------- 
     686      ! Output filename Xn=F(X0) 
     687      !-------------------------------------------------------------------- 
     688      CALL tlm_namrd 
     689      gamma = h_ratio    
     690      file_wop='trj_wop_solsor' 
     691      file_xdx='trj_xdx_solsor' 
     692      !-------------------------------------------------------------------- 
     693      ! Initialize the tangent input with random noise: dx 
     694      !-------------------------------------------------------------------- 
     695      IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN 
     696         CALL grid_rd_sd( 596035, zr,  c_solver_pt, 0.0_wp, stdgc)     
     697         DO jj = nldj, nlej 
     698            DO ji = nldi, nlei 
     699               zgcb_tlin(ji,jj) = zr(ji,jj) 
     700            END DO 
     701         END DO      
     702         CALL grid_rd_sd( 264792, zr,  c_solver_pt, 0.0_wp, stdgc)     
     703         DO jj = nldj, nlej 
     704            DO ji = nldi, nlei 
     705               zgcx_tlin(ji,jj) = zr(ji,jj) 
     706            END DO 
     707         END DO 
     708      ENDIF 
     709 
     710      !-------------------------------------------------------------------- 
     711      ! Complete Init for Direct 
     712      !------------------------------------------------------------------- 
     713      CALL istate_p 
     714 
     715      ! *** initialize the reference trajectory 
     716      ! ------------ 
     717 
     718!      gcx  (:,:) = ( ua(:,:,1) + ub(:,:,1) ) / 10.0_wp 
     719!      gcb  (:,:) = ( ua(:,:,3) + ub(:,:,3) ) / 10.0_wp 
     720      CALL  trj_rea( nit000-1, 1 )  
     721      CALL  trj_rea( nit000, 1 ) 
     722      gcx  (:,:) =  un(:,:,1) / 10.0_wp 
     723      gcb  (:,:) =  un(:,:,3) / 10.0_wp 
     724 
     725      IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN 
     726         zgcb_tlin(:,:) = gamma * zgcb_tlin(:,:) 
     727         gcb(:,:)       = gcb(:,:) + zgcb_tlin(:,:) 
     728 
     729         zgcx_tlin(:,:) = gamma * zgcx_tlin(:,:) 
     730         gcx(:,:)       = gcx(:,:) + zgcx_tlin(:,:) 
     731      ENDIF  
     732 
     733      !-------------------------------------------------------------------- 
     734      !  Compute the direct model F(X0,t=n) = Xn 
     735      !-------------------------------------------------------------------- 
     736      kindic=0 
     737      ncut=1 
     738      IF ( tlm_bch /= 2 ) CALL sol_sor(kindic) 
     739      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     740      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
     741      !-------------------------------------------------------------------- 
     742      !  Compute the Tangent  
     743      !-------------------------------------------------------------------- 
     744      IF ( tlm_bch == 2 ) THEN 
     745         !-------------------------------------------------------------------- 
     746         ! Initialize the tangent variables: dy^* = W dy   
     747         !-------------------------------------------------------------------- 
     748         gcr_tl(:,:) = 0.0_wp 
     749         gcb_tl  (:,:) = zgcb_tlin  (:,:) 
     750         gcx_tl  (:,:) = zgcx_tlin  (:,:) 
     751 
     752         !----------------------------------------------------------------------- 
     753         !  Initialization of the dynamics and tracer fields for the tangent 
     754         !----------------------------------------------------------------------- 
     755         ncut=1 !reset indicator of solver convergence 
     756         CALL sol_sor_tan(nit000, kindic) 
     757         !-------------------------------------------------------------------- 
     758         ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 
     759         !-------------------------------------------------------------------- 
     760 
     761         zsp_gcx    = DOT_PRODUCT( gcx_tl, gcx_tl  ) 
     762         zsp2       = zsp_gcx 
     763         !-------------------------------------------------------------------- 
     764         !  Storing data 
     765         !-------------------------------------------------------------------- 
     766         CALL trj_rd_spl(file_wop)  
     767         zgcx_wop  (:,:) = gcx  (:,:) 
     768         CALL trj_rd_spl(file_xdx)  
     769         zgcx_out  (:,:) = gcx  (:,:) 
     770         !-------------------------------------------------------------------- 
     771         ! Compute the Linearization Error  
     772         ! Nn = M( X0+gamma.dX0, t0,tn) - M(X0, t0,tn) 
     773         ! and  
     774         ! Compute the Linearization Error  
     775         ! En = Nn -TL(gamma.dX0, t0,tn) 
     776         !-------------------------------------------------------------------- 
     777         ! Warning: Here we re-use local variables z()_out and z()_wop 
     778         ii=0 
     779         DO jj = 1, jpj 
     780            DO ji = 1, jpi 
     781               zgcx_out   (ji,jj) = zgcx_out    (ji,jj) - zgcx_wop  (ji,jj) 
     782               zgcx_wop   (ji,jj) = zgcx_out    (ji,jj) - gcx_tl    (ji,jj) 
     783               IF (  gcx_tl(ji,jj) .NE. 0.0_wp ) zerrgcx(ji,jj) = zgcx_out(ji,jj)/gcx_tl(ji,jj) 
     784               IF( (MOD(ji, isamp) .EQ. 0) .AND. & 
     785               &   (MOD(jj, jsamp) .EQ. 0) ) THEN 
     786                   ii = ii+1 
     787                   iiposgcx(ii) = ji 
     788                   ijposgcx(ii) = jj 
     789                   IF ( INT(tmask(ji,jj,1)) .NE. 0)  THEN 
     790                      zscgcx (ii)    =  zgcx_wop(ji,jj) 
     791                      zscerrgcx (ii) =  ( zerrgcx(ji,jj) - 1.0_wp ) / gamma 
     792                   ENDIF 
     793               ENDIF 
     794            END DO 
     795         END DO 
     796 
     797         zsp_gcx   = DOT_PRODUCT( zgcx_out, zgcx_out  ) 
     798 
     799         zsp1      = zsp_gcx 
     800 
     801         zsp_gcx   = DOT_PRODUCT( zgcx_wop, zgcx_wop  ) 
     802 
     803         zsp3      = zsp_gcx 
     804         !-------------------------------------------------------------------- 
     805         ! Print the linearization error En - norme 2 
     806         !-------------------------------------------------------------------- 
     807         ! 14 char:'12345678901234' 
     808         cl_name = 'sol_sor: En   ' 
     809         zsp    = SQRT(zsp3) 
     810         zgsp5   = zsp 
     811         CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) 
     812 
     813         !-------------------------------------------------------------------- 
     814         ! Compute TLM norm2 
     815         !-------------------------------------------------------------------- 
     816         zsp      = SQRT(zsp2) 
     817 
     818         zgsp4    = zsp 
     819         cl_name  = 'sol_sor: Ln2 ' 
     820         CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) 
     821 
     822         !-------------------------------------------------------------------- 
     823         ! Print the linearization error Nn - norme 2 
     824         !-------------------------------------------------------------------- 
     825         zsp     = SQRT(zsp1) 
     826 
     827         cl_name = 'solsor:Mhdx-Mx' 
     828         CALL prntst_tlm( cl_name, kumadt, zsp, h_ratio ) 
     829 
     830         zgsp3    = SQRT( zsp3/zsp2 ) 
     831         zgsp7    = zgsp3/gamma 
     832         zgsp1    = zsp 
     833         zgsp2    = zgsp1 / zgsp4 
     834         zgsp6    = (zgsp2 - 1.0_wp)/gamma 
     835 
     836         FMT = "(A8,2X,I4.4,2X,E6.1,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13)" 
     837         WRITE(numtan,FMT) 'solsor  ', cur_loop, h_ratio, zgsp1, zgsp2, zgsp3, zgsp4, zgsp5, zgsp6, zgsp7 
     838         !-------------------------------------------------------------------- 
     839         ! Unitary calculus 
     840         !-------------------------------------------------------------------- 
     841         FMT = "(A8,2X,A8,2X,I4.4,2X,E6.1,2X,I4.4,2X,I4.4,2X,I4.4,2X,E20.13,1X)" 
     842         cl_name ='sol_sor ' 
     843         IF(lwp) THEN 
     844            DO ii=1, 100, 1 
     845               IF ( zscgcx(ii) .NE. 0.0_wp ) WRITE(numtan_sc,FMT) cl_name, 'zscgcx    ', & 
     846                    & cur_loop, h_ratio, ii, iiposgcx(ii), ijposgcx(ii), zscgcx(ii) 
     847            ENDDO 
     848            DO ii=1, 100, 1 
     849               IF ( zscerrgcx(ii) .NE. 0.0_wp ) WRITE(numtan_sc,FMT) cl_name, 'zscerrgcx ', & 
     850                    & cur_loop, h_ratio, ii, iiposgcx(ii), ijposgcx(ii), zscerrgcx(ii) 
     851            ENDDO 
     852            ! write separator 
     853            WRITE(numtan_sc,"(A4)") '====' 
     854         ENDIF 
     855 
     856      ENDIF 
     857 
     858      DEALLOCATE(      & 
     859         & zgcb_tlin,  & 
     860         & zgcx_tlin,  & 
     861         & zgcb_out ,  & 
     862         & zgcx_out ,  & 
     863         & zgcb_wop ,  & 
     864         & zgcx_wop ,  & 
     865         & zr          & 
     866         & ) 
     867#else 
     868      !! * Arguments 
     869      INTEGER, INTENT(IN) :: & 
     870         & kumadt             ! Output unit 
     871      ! dummy routine 
     872#endif 
     873   END SUBROUTINE sol_sor_tlm_tst 
     874#endif    
    550875END MODULE solsor_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TAM/trj_tam.F90

    r2586 r2587  
    3232   USE wzvmod             !  vertical velocity 
    3333   
     34   USE oce_tam, ONLY : &      ! Dynamics and active tracers defined in memory 
     35      & un_tl, vn_tl, tn_tl, & 
     36      & wn_tl, hdivn_tl, rotn_tl,              & 
     37#if defined key_dynspg_flt 
     38      & sshn_tl, & 
     39#endif 
     40      & sn_tl 
     41   
    3442   IMPLICIT NONE 
    3543 
    … …  
    3947      & trj_rea,     &   !: Read trajectory at time step kstep into now fields 
    4048      & trj_rd_spl,  &   !: Read simple data (without interpolation) 
    41       & trj_wri_spl      !: Write simple data (without interpolation) 
     49      & trj_wri_spl, &   !: Write simple data (without interpolation) 
     50      & tl_trj_wri,  &   !: Write simple linear-tangent data 
     51      & tl_trj_ini,  &   !: initialize the model-tangent state trajectory 
     52      & trj_deallocate   !: Deallocate all the saved variable 
     53 
     54   LOGICAL, PUBLIC :: &  
     55      & ln_trjwri_tan = .FALSE.   !: No output of the state trajectory fields 
     56 
     57   CHARACTER (LEN=40), PUBLIC, PARAMETER :: & 
     58      & c_tantrj = 'tl_trajectory'                !: Filename for storing the  
     59                                                   !: linear-tangent trajectory 
     60   INTEGER, PUBLIC :: &           
     61      & nittrjfrq_tan         !: Frequency of trajectory output for linear-tangent 
    4262 
    4363   !! * Module variables 
     64   LOGICAL, SAVE :: &  
     65      & ln_mem = .FALSE.      !: Flag for allocation  
    4466   INTEGER, SAVE :: inumtrj1 = -1, inumtrj2 = -1 
    4567   REAL(wp), SAVE :: & 
    … …  
    107129CONTAINS 
    108130 
     131   SUBROUTINE tl_trj_ini 
     132      !!----------------------------------------------------------------------- 
     133      !! 
     134      !!                  ***  ROUTINE tl_trj_ini *** 
     135      !! 
     136      !! ** Purpose : initialize the model-tangent state trajectory  
     137      !! 
     138      !! ** Method  :  
     139      !! 
     140      !! ** Action  : 
     141      !!                    
     142      !! References :  
     143      !! 
     144      !! History : 
     145      !!        ! 10-07 (F. Vigilant)  
     146      !!----------------------------------------------------------------------- 
     147 
     148      IMPLICIT NONE 
     149 
     150      !! * Modules used 
     151      NAMELIST/namtl_trj/ nittrjfrq_tan, ln_trjwri_tan 
     152 
     153      ln_trjwri_tan = .FALSE. 
     154      nittrjfrq_tan = 1 
     155 
     156      REWIND ( numnam ) 
     157      READ   ( numnam, namtl_trj ) 
     158 
     159      ! Control print 
     160      IF(lwp) THEN 
     161         WRITE(numout,*) 
     162         WRITE(numout,*) 'tl_trj_ini : Linear-Tagent Trajectory handling:' 
     163         WRITE(numout,*) '~~~~~~~~~~~~' 
     164         WRITE(numout,*) '          Namelist namtl_trj : set trajectory parameters' 
     165         WRITE(numout,*) '             Logical switch for writing out state trajectory         ', & 
     166            &            ' ln_trjwri_tan = ', ln_trjwri_tan 
     167         WRITE(numout,*) '             Frequency of trajectory output                          ', & 
     168            &            ' nittrjfrq_tan = ', nittrjfrq_tan 
     169      END IF 
     170   END SUBROUTINE tl_trj_ini 
     171 
    109172   SUBROUTINE trj_rea( kstp, kdir ) 
    110173      !!----------------------------------------------------------------------- 
    … …  
    242305               & ) 
    243306#endif 
     307       ln_mem = .TRUE. 
    244308 
    245309         ENDIF 
    … …  
    310374 
    311375         ENDIF 
    312 ! added 
     376 
    313377         IF ( ( kstp - nit000 + 1 /= 0 ) .AND. ( kdir == -1 ) ) THEN 
    314378            ! We update the input filename  
    … …  
    321385            ENDIF 
    322386         ENDIF 
    323 ! end added 
     387 
    324388         ! Read record 1 
    325389 
    … …  
    328392 
    329393            IF ( kdir == -1 ) inrcm = inrcm - 1 
    330 !added 
    331394!            inrc = inrcm 
    332395            ! temporary fix: currently, only one field by step time 
    333396            inrc = 1 
    334397            stpr1 = (inrcm - 1) * nittrjfrq 
    335 !            stpr1 = (inrc - 1) * nittrjfrq  
    336 !end added 
    337398 
    338399            ! bug fixed to read several time the initial data 
    … …  
    351412            IF ( inumtrj1 /= -1 )   CALL iom_open( cl_asmtrj, inumtrj1 ) 
    352413 
    353             CALL iom_get( inumtrj1, jpdom_data, 'emp'   , empr1   , inrc ) 
    354             CALL iom_get( inumtrj1, jpdom_data, 'emps'  , empsr1  , inrc ) 
    355             CALL iom_get( inumtrj1, jpdom_data, 'un'    , unr1    , inrc ) 
    356             CALL iom_get( inumtrj1, jpdom_data, 'vn'    , vnr1    , inrc ) 
    357             CALL iom_get( inumtrj1, jpdom_data, 'tn'    , tnr1    , inrc ) 
    358             CALL iom_get( inumtrj1, jpdom_data, 'sn'    , snr1    , inrc ) 
    359             CALL iom_get( inumtrj1, jpdom_data, 'avmu'  , avmur1  , inrc ) 
    360             CALL iom_get( inumtrj1, jpdom_data, 'avmv'  , avmvr1  , inrc ) 
    361             CALL iom_get( inumtrj1, jpdom_data, 'avt'   , avtr1   , inrc ) 
     414            CALL iom_get( inumtrj1, jpdom_autoglo, 'emp'   , empr1   , inrc ) 
     415            CALL iom_get( inumtrj1, jpdom_autoglo, 'emps'  , empsr1  , inrc ) 
     416            CALL iom_get( inumtrj1, jpdom_autoglo, 'un'    , unr1    , inrc ) 
     417            CALL iom_get( inumtrj1, jpdom_autoglo, 'vn'    , vnr1    , inrc ) 
     418            CALL iom_get( inumtrj1, jpdom_autoglo, 'tn'    , tnr1    , inrc ) 
     419            CALL iom_get( inumtrj1, jpdom_autoglo, 'sn'    , snr1    , inrc ) 
     420            CALL iom_get( inumtrj1, jpdom_autoglo, 'avmu'  , avmur1  , inrc ) 
     421            CALL iom_get( inumtrj1, jpdom_autoglo, 'avmv'  , avmvr1  , inrc ) 
     422            CALL iom_get( inumtrj1, jpdom_autoglo, 'avt'   , avtr1   , inrc ) 
    362423#if defined key_ldfslp 
    363             CALL iom_get( inumtrj1, jpdom_data, 'uslp'  , uslpr1  , inrc ) 
    364             CALL iom_get( inumtrj1, jpdom_data, 'vslp'  , vslpr1  , inrc ) 
    365             CALL iom_get( inumtrj1, jpdom_data, 'wslpi' , wslpir1 , inrc ) 
    366             CALL iom_get( inumtrj1, jpdom_data, 'wslpj' , wslpjr1 , inrc ) 
     424            CALL iom_get( inumtrj1, jpdom_autoglo, 'uslp'  , uslpr1  , inrc ) 
     425            CALL iom_get( inumtrj1, jpdom_autoglo, 'vslp'  , vslpr1  , inrc ) 
     426            CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpi' , wslpir1 , inrc ) 
     427            CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpj' , wslpjr1 , inrc ) 
    367428#endif 
    368429#if defined key_zdfddm 
    369             CALL iom_get( inumtrj1, jpdom_data, 'avs'   , avsr1   , inrc ) 
    370 #endif 
    371             CALL iom_get( inumtrj1, jpdom_data, 'ta'    , tar1    , inrc ) 
    372             CALL iom_get( inumtrj1, jpdom_data, 'sa'    , sar1    , inrc ) 
    373             CALL iom_get( inumtrj1, jpdom_data, 'tb'    , tbr1    , inrc ) 
    374             CALL iom_get( inumtrj1, jpdom_data, 'sb'    , sbr1    , inrc ) 
     430            CALL iom_get( inumtrj1, jpdom_autoglo, 'avs'   , avsr1   , inrc ) 
     431#endif 
     432            CALL iom_get( inumtrj1, jpdom_autoglo, 'ta'    , tar1    , inrc ) 
     433            CALL iom_get( inumtrj1, jpdom_autoglo, 'sa'    , sar1    , inrc ) 
     434            CALL iom_get( inumtrj1, jpdom_autoglo, 'tb'    , tbr1    , inrc ) 
     435            CALL iom_get( inumtrj1, jpdom_autoglo, 'sb'    , sbr1    , inrc ) 
    375436#if defined key_tradmp 
    376             CALL iom_get( inumtrj1, jpdom_data, 'hmlp'  , hmlp1   , inrc ) 
     437            CALL iom_get( inumtrj1, jpdom_autoglo, 'hmlp'  , hmlp1   , inrc ) 
    377438#endif 
    378439#if defined key_traldf_eiv 
    379             CALL iom_get( inumtrj1, jpdom_data, 'aeiu'  , aeiur1  , inrc ) 
    380             CALL iom_get( inumtrj1, jpdom_data, 'aeiv'  , aeivr1  , inrc ) 
    381             CALL iom_get( inumtrj1, jpdom_data, 'aeiw'  , aeiwr1  , inrc ) 
     440            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiu'  , aeiur1  , inrc ) 
     441            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiv'  , aeivr1  , inrc ) 
     442            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiw'  , aeiwr1  , inrc ) 
    382443#endif 
    383444            CALL iom_close( inumtrj1 ) 
    … …  
    450511         ! Read record 2 
    451512 
    452 !!         IF ( ( kstp /= nitend ) .AND. ( kdir == 1  ) .OR. & 
    453 !!            & ( kstp == nitend ) .AND. ( kdir == -1 ) ) THEN     
    454 ! change 
    455513         IF ( ( ( kstp /= nitend ) .AND. ( kdir == 1  )) .OR. & 
    456514            &   ( kstp == nitend ) .AND.(  kdir == -1   ) ) THEN 
    457 ! end change 
    458 !added 
    459 !            ! Need to open next saved file when kstp = initial step    
    460 !            IF  ( kstp - nit000 + 1 == 0 ) THEN      
    461             ! Need to open next saved file when kstp = initial step    
    462 ! change      
    463 !            IF ( ( kstp /= nitend ) .AND. ( kdir == 1 ) ) THEN  
    464 ! end change 
    465 ! end added 
     515 
    466516               ! Define the input file  
    467517               IF  (  kdir == -1   ) THEN 
    … …  
    479529 
    480530               CALL iom_open( cl_asmtrj, inumtrj2 )  
    481 ! change 
    482 !            END IF 
    483 !end change 
     531 
    484532 
    485533            inrcp = inrcm + 1 
    486534            !            inrc  = inrcp 
    487 !added 
    488535            inrc = 1  ! temporary  fix 
    489 !end added 
     536 
    490537            stpr2 = (inrcp - 1) * nittrjfrq  
    491             CALL iom_get( inumtrj2, jpdom_data, 'emp'   , empr2   , inrc ) 
    492             CALL iom_get( inumtrj2, jpdom_data, 'emps'  , empsr2  , inrc ) 
    493             CALL iom_get( inumtrj2, jpdom_data, 'un'    , unr2    , inrc ) 
    494             CALL iom_get( inumtrj2, jpdom_data, 'vn'    , vnr2    , inrc ) 
    495             CALL iom_get( inumtrj2, jpdom_data, 'tn'    , tnr2    , inrc ) 
    496             CALL iom_get( inumtrj2, jpdom_data, 'sn'    , snr2    , inrc ) 
    497             CALL iom_get( inumtrj2, jpdom_data, 'avmu'  , avmur2  , inrc ) 
    498             CALL iom_get( inumtrj2, jpdom_data, 'avmv'  , avmvr2  , inrc ) 
    499             CALL iom_get( inumtrj2, jpdom_data, 'avt'   , avtr2   , inrc ) 
     538            CALL iom_get( inumtrj2, jpdom_autoglo, 'emp'   , empr2   , inrc ) 
     539            CALL iom_get( inumtrj2, jpdom_autoglo, 'emps'  , empsr2  , inrc ) 
     540            CALL iom_get( inumtrj2, jpdom_autoglo, 'un'    , unr2    , inrc ) 
     541            CALL iom_get( inumtrj2, jpdom_autoglo, 'vn'    , vnr2    , inrc ) 
     542            CALL iom_get( inumtrj2, jpdom_autoglo, 'tn'    , tnr2    , inrc ) 
     543            CALL iom_get( inumtrj2, jpdom_autoglo, 'sn'    , snr2    , inrc ) 
     544            CALL iom_get( inumtrj2, jpdom_autoglo, 'avmu'  , avmur2  , inrc ) 
     545            CALL iom_get( inumtrj2, jpdom_autoglo, 'avmv'  , avmvr2  , inrc ) 
     546            CALL iom_get( inumtrj2, jpdom_autoglo, 'avt'   , avtr2   , inrc ) 
    500547#if defined key_ldfslp 
    501             CALL iom_get( inumtrj2, jpdom_data, 'uslp'  , uslpr2  , inrc ) 
    502             CALL iom_get( inumtrj2, jpdom_data, 'vslp'  , vslpr2  , inrc ) 
    503             CALL iom_get( inumtrj2, jpdom_data, 'wslpi' , wslpir2 , inrc ) 
    504             CALL iom_get( inumtrj2, jpdom_data, 'wslpj' , wslpjr2 , inrc ) 
     548            CALL iom_get( inumtrj2, jpdom_autoglo, 'uslp'  , uslpr2  , inrc ) 
     549            CALL iom_get( inumtrj2, jpdom_autoglo, 'vslp'  , vslpr2  , inrc ) 
     550            CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpi' , wslpir2 , inrc ) 
     551            CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpj' , wslpjr2 , inrc ) 
    505552#endif 
    506553#if defined key_zdfddm 
    507             CALL iom_get( inumtrj2, jpdom_data, 'avs'   , avsr2   , inrc ) 
    508 #endif 
    509             CALL iom_get( inumtrj2, jpdom_data, 'ta'    , tar2    , inrc ) 
    510             CALL iom_get( inumtrj2, jpdom_data, 'sa'    , sar2    , inrc ) 
    511             CALL iom_get( inumtrj2, jpdom_data, 'tb'    , tbr2    , inrc ) 
    512             CALL iom_get( inumtrj2, jpdom_data, 'sb'    , sbr2    , inrc ) 
     554            CALL iom_get( inumtrj2, jpdom_autoglo, 'avs'   , avsr2   , inrc ) 
     555#endif 
     556            CALL iom_get( inumtrj2, jpdom_autoglo, 'ta'    , tar2    , inrc ) 
     557            CALL iom_get( inumtrj2, jpdom_autoglo, 'sa'    , sar2    , inrc ) 
     558            CALL iom_get( inumtrj2, jpdom_autoglo, 'tb'    , tbr2    , inrc ) 
     559            CALL iom_get( inumtrj2, jpdom_autoglo, 'sb'    , sbr2    , inrc ) 
    513560#if defined key_tradmp 
    514             CALL iom_get( inumtrj2, jpdom_data, 'hmlp'  , hmlp2   , inrc ) 
     561            CALL iom_get( inumtrj2, jpdom_autoglo, 'hmlp'  , hmlp2   , inrc ) 
    515562#endif 
    516563#if defined key_traldf_eiv 
    517             CALL iom_get( inumtrj2, jpdom_data, 'aeiu'  , aeiur2  , inrc ) 
    518             CALL iom_get( inumtrj2, jpdom_data, 'aeiv'  , aeivr2  , inrc ) 
    519             CALL iom_get( inumtrj2, jpdom_data, 'aeiw'  , aeiwr2  , inrc ) 
     564            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiu'  , aeiur2  , inrc ) 
     565            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiv'  , aeivr2  , inrc ) 
     566            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiw'  , aeiwr2  , inrc ) 
    520567#endif 
    521568            CALL iom_close( inumtrj2 ) 
    … …  
    526573         ENDIF 
    527574 
     575      ENDIF 
     576 
     577      ! Add warning for user 
     578      IF ( (kstp == nitend) .AND. ( MOD( kstp - nit000 + 1, nittrjfrq ) /= 0 )  ) THEN 
     579          IF(lwp) WRITE(numout,*) '   Warning ! nitend (=',nitend, ')', & 
     580               &                  ' and saving frequency (=',nittrjfrq,') not compatible.' 
    528581      ENDIF 
    529582 
    … …  
    611664      !! *Module udes 
    612665      USE iom   
     666      USE sol_oce, ONLY : & ! solver variables 
     667      & gcb, gcx 
    613668      !! * Arguments 
    614669      !! * Local declarations 
    … …  
    647702      CALL iom_rstput( fd, fd, inum, 'grv'  , grv  ) 
    648703      CALL iom_rstput( fd, fd, inum, 'rn2'  , rn2  ) 
     704      CALL iom_rstput( fd, fd, inum, 'gcb'  , gcb  ) 
     705      CALL iom_rstput( fd, fd, inum, 'gcx'  , gcx  ) 
    649706 
    650707      CALL iom_close( inum ) 
    … …  
    668725      !! *Module udes 
    669726      USE iom                 ! I/O module 
     727      USE sol_oce, ONLY : & ! solver variables 
     728      & gcb, gcx 
    670729      !! * Arguments 
    671730      !! * Local declarations 
    … …  
    704763      CALL iom_get( inum, jpdom_autoglo, 'grv'  , grv,  fd ) 
    705764      CALL iom_get( inum, jpdom_autoglo, 'rn2'  , rn2,  fd ) 
     765      CALL iom_get( inum, jpdom_autoglo, 'gcb'  , gcb,  fd ) 
     766      CALL iom_get( inum, jpdom_autoglo, 'gcx'  , gcx,  fd ) 
    706767 
    707768      CALL iom_close( inum ) 
    … …  
    709770   END SUBROUTINE trj_rd_spl 
    710771 
     772   SUBROUTINE tl_trj_wri(kstp) 
     773      !!----------------------------------------------------------------------- 
     774      !! 
     775      !!                  ***  ROUTINE tl_trj_wri *** 
     776      !! 
     777      !! ** Purpose : Write SimPLe data to file the model state trajectory 
     778      !! 
     779      !! ** Method  :  
     780      !! 
     781      !! ** Action  : 
     782      !! 
     783      !! History :  
     784      !!        ! 10-07 (F. Vigilant)  
     785      !!----------------------------------------------------------------------- 
     786      !! *Module udes 
     787      USE iom   
     788      !! * Arguments 
     789      INTEGER, INTENT(in) :: & 
     790         & kstp           ! Step for requested trajectory 
     791      !! * Local declarations 
     792      INTEGER :: & 
     793         & inum           ! File unit number 
     794      INTEGER :: & 
     795         & it 
     796      CHARACTER (LEN=50) :: & 
     797         & filename 
     798      CHARACTER (LEN=100) :: & 
     799         & cl_tantrj       
     800 
     801      ! Initialize data and open file 
     802      !! if step time is corresponding to a saved state 
     803      IF ( ( MOD( kstp - nit000 + 1, nittrjfrq_tan ) == 0 )  ) THEN        
     804 
     805         it = kstp - nit000 + 1 
     806 
     807            ! Define the input file  
     808            WRITE(cl_tantrj, FMT='(A,A,I5.5,".nc")' ) TRIM( c_tantrj ), '_', it 
     809            cl_tantrj = TRIM( cl_tantrj ) 
     810 
     811            IF(lwp) THEN 
     812               WRITE(numout,*) 
     813               WRITE(numout,*)'Writing linear-tangent fields from : ',TRIM(cl_tantrj) 
     814               WRITE(numout,*) 
     815            ENDIF 
     816 
     817            CALL iom_open( cl_tantrj, inum, ldwrt = .TRUE., kiolib = jprstlib) 
     818             
     819            ! Output trajectory fields 
     820            CALL iom_rstput( it, it, inum, 'un_tl'   , un_tl   ) 
     821            CALL iom_rstput( it, it, inum, 'vn_tl'   , vn_tl   ) 
     822            CALL iom_rstput( it, it, inum, 'tn_tl'   , tn_tl   ) 
     823            CALL iom_rstput( it, it, inum, 'sn_tl'   , sn_tl   ) 
     824            CALL iom_rstput( it, it, inum, 'wn_tl'   , wn_tl   ) 
     825            CALL iom_rstput( it, it, inum, 'hdivn_tl', hdivn_tl) 
     826            CALL iom_rstput( it, it, inum, 'rotn_tl' , rotn_tl ) 
     827#if defined key_dynspg_flt 
     828            CALL iom_rstput( it, it, inum, 'sshn_tl' , sshn_tl ) 
     829#endif 
     830            CALL iom_close( inum ) 
     831 
     832         ENDIF 
     833 
     834   END SUBROUTINE tl_trj_wri 
     835 
     836 
     837   SUBROUTINE trj_deallocate 
     838      !!----------------------------------------------------------------------- 
     839      !! 
     840      !!                  ***  ROUTINE trj_deallocate *** 
     841      !! 
     842      !! ** Purpose : Deallocate saved trajectory arrays 
     843      !! 
     844      !! ** Method  :  
     845      !! 
     846      !! ** Action  : 
     847      !! 
     848      !! History :  
     849      !!        ! 2010-06 (A. Vidard) 
     850      !!----------------------------------------------------------------------- 
     851 
     852         IF ( ln_mem ) THEN 
     853            DEALLOCATE(  & 
     854               & empr1,  & 
     855               & empsr1, & 
     856               & empr2,  & 
     857               & empsr2  & 
     858               & ) 
     859 
     860            DEALLOCATE(    & 
     861               & unr1,     & 
     862               & vnr1,     & 
     863               & tnr1,     & 
     864               & snr1,     & 
     865               & avmur1,   & 
     866               & avmvr1,   & 
     867               & avtr1,    & 
     868               & tar1,     & 
     869               & sar1,     & 
     870               & tbr1,     & 
     871               & sbr1,     & 
     872               & unr2,     & 
     873               & vnr2,     & 
     874               & tnr2,     & 
     875               & snr2,     & 
     876               & avmur2,   & 
     877               & avmvr2,   & 
     878               & avtr2,    & 
     879               & tar2,     & 
     880               & sar2,     & 
     881               & tbr2,     & 
     882               & sbr2      & 
     883               & ) 
     884 
     885#if defined key_traldf_eiv 
     886#if defined key_traldf_c3d 
     887#elif defined key_traldf_c2d 
     888            DEALLOCATE(  & 
     889               & aeiur1, & 
     890               & aeivr1, & 
     891               & aeiwr1, & 
     892               & aeiur2, & 
     893               & aeivr2, & 
     894               & aeiwr2  & 
     895               & ) 
     896#elif defined key_traldf_c1d 
     897#endif 
     898#endif 
     899 
     900#if defined key_ldfslp 
     901            DEALLOCATE( & 
     902               & uslpr1,   & 
     903               & vslpr1,   & 
     904               & wslpir1,  & 
     905               & wslpjr1,  & 
     906               & uslpr2,   & 
     907               & vslpr2,   & 
     908               & wslpir2,  & 
     909               & wslpjr2   & 
     910               & ) 
     911#endif 
     912 
     913#if defined key_zdfddm 
     914            DEALLOCATE( & 
     915               & avsr1,    & 
     916               & avsr2     & 
     917               & ) 
     918#endif 
     919 
     920#if defined key_tradmp 
     921            DEALLOCATE( & 
     922               & hmlp1,    & 
     923               & hmlp2     & 
     924               & ) 
     925#endif 
     926    ENDIF 
     927     END SUBROUTINE trj_deallocate 
    711928#endif 
    712929END MODULE trj_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_cen2_tam.F90

    r1885 r2587  
    127127   PUBLIC   tra_adv_cen2_adj    ! routine called by traadv_tam.F90 
    128128   PUBLIC   tra_adv_cen2_adj_tst! routine called by tst.F90 
     129#if defined key_tst_tlm 
    129130   PUBLIC   tra_adv_cen2_tlm_tst! routine called by tamtst.F90 
     131#endif 
    130132 
    131133   REAL(wp), DIMENSION(jpi,jpj) ::  & 
    … …  
    935937 
    936938   END SUBROUTINE tra_adv_cen2_adj_tst 
    937  
     939#if defined key_tst_tlm 
    938940SUBROUTINE tra_adv_cen2_tlm_tst( kumadt ) 
    939941      !!----------------------------------------------------------------------- 
    … …  
    968970      USE tamtrj              ! writing out state trajectory 
    969971      USE par_tlm,    ONLY: & 
     972        & tlm_bch,          & 
    970973        & cur_loop,         & 
    971974        & h_ratio 
    … …  
    10271030         & z3r 
    10281031      CHARACTER(LEN=14)   :: cl_name 
    1029       CHARACTER (LEN=128) :: file_out, file_wop 
     1032      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    10301033      CHARACTER (LEN=90)  :: FMT 
    10311034      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    10841087      ! Output filename Xn=F(X0) 
    10851088      !-------------------------------------------------------------------- 
    1086       file_wop='trj_wop_tradv_cen2' 
    10871089      CALL tlm_namrd 
    10881090      gamma = h_ratio      
     1091      file_wop='trj_wop_tradv_cen2' 
     1092      file_xdx='trj_xdx_tradv_cen2'    
    10891093      !-------------------------------------------------------------------- 
    10901094      ! Initialize the tangent input with random noise: dx 
    … …  
    11511155      ! Complete Init for Direct 
    11521156      !------------------------------------------------------------------- 
    1153       CALL istate_p   
     1157      IF ( tlm_bch /= 2 ) CALL istate_p   
    11541158 
    11551159      ! *** initialize the reference trajectory 
    … …  
    11841188      !  Compute the direct model F(X0,t=n) = Xn 
    11851189      !-------------------------------------------------------------------- 
    1186       CALL tra_adv_cen2(nit000, un, vn, wn) 
    1187       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     1190      IF ( tlm_bch /= 2 ) CALL tra_adv_cen2(nit000, un, vn, wn) 
     1191      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1192      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    11881193      !-------------------------------------------------------------------- 
    11891194      !  Compute the Tangent  
    11901195      !-------------------------------------------------------------------- 
    1191       IF ( cur_loop .NE. 0) THEN 
    1192          !-------------------------------------------------------------------- 
    1193          !  Storing data 
    1194          !--------------------------------------------------------------------     
    1195          zta_out  (:,:,:) = ta   (:,:,:) 
    1196          zsa_out  (:,:,:) = sa   (:,:,:)           
    1197  
     1196      IF ( tlm_bch == 2 ) THEN        
    11981197         !-------------------------------------------------------------------- 
    11991198         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    12141213         ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 
    12151214         !-------------------------------------------------------------------- 
    1216  
    12171215         zsp2_Ta    = DOT_PRODUCT( ta_tl, ta_tl  ) 
    12181216         zsp2_Sa    = DOT_PRODUCT( sa_tl, sa_tl  ) 
    12191217 
    12201218         zsp2      = zsp2_Ta + zsp2_Sa 
    1221    
    12221219         !-------------------------------------------------------------------- 
    12231220         !  Storing data 
    12241221         !-------------------------------------------------------------------- 
    12251222         CALL trj_rd_spl(file_wop)  
    1226  
    12271223         zta_wop  (:,:,:) = ta  (:,:,:) 
    12281224         zsa_wop  (:,:,:) = sa  (:,:,:) 
    1229  
     1225         CALL trj_rd_spl(file_xdx)  
     1226         zta_out  (:,:,:) = ta  (:,:,:) 
     1227         zsa_out  (:,:,:) = sa  (:,:,:) 
    12301228         !-------------------------------------------------------------------- 
    12311229         ! Compute the Linearization Error  
    … …  
    13721370  END SUBROUTINE  tra_adv_cen2_tlm_tst 
    13731371#endif 
    1374  
     1372#endif 
    13751373   !!====================================================================== 
    13761374END MODULE traadv_cen2_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_eiv_tam.F90

    r1885 r2587  
    2323      & wp 
    2424   USE par_oce       , ONLY: & ! Ocean space and time domain variables 
    25       & jpi,                 & 
    26       & jpj,                 &  
    27       & jpk  
     25      & jpi, jpj, jpk  
     26   USE in_out_manager, ONLY: & ! I/O manager  
     27      & lwp, numout               
    2828 
    2929   IMPLICIT NONE 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_tam.F90

    r1885 r2587  
    4343      & tra_adv_cen2_tan,     & 
    4444      & tra_adv_cen2_adj,     & 
    45       & tra_adv_cen2_adj_tst, & 
    46       & tra_adv_cen2_tlm_tst 
     45#if defined key_tst_tlm 
     46      & tra_adv_cen2_tlm_tst, & 
     47#endif 
     48      & tra_adv_cen2_adj_tst 
    4749   USE traadv_eiv_tam, ONLY: & ! advection trend - eddy induced velocity (tra_adv_eiv   routine) 
    4850      & tra_adv_eiv_tan,     & 
    4951      & tra_adv_eiv_adj 
    50 !   USE in_out_manager, ONLY : & ! I/O manager  
    51 !      & lwp,                  & 
    52 !      & numout,               & 
    53 !      & nit000 
    5452   USE in_out_manager  ! I/O manager 
    5553   USE prtctl          ! Print control 
    … …  
    6260   PUBLIC   tra_adv_ctl_tam ! routine called by stepadj module 
    6361   PUBLIC   tra_adv_adj_tst ! routine called by tst module 
     62#if defined key_tst_tlm 
    6463   PUBLIC   tra_adv_tlm_tst ! routine called by tst module 
     64#endif 
    6565   !!* Namelist nam_traadv 
    6666   LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
    … …  
    305305      ! 
    306306   END SUBROUTINE tra_adv_ctl_tam 
    307  
     307#if defined key_tst_tlm 
    308308SUBROUTINE tra_adv_tlm_tst( kumadt ) 
    309309      !!----------------------------------------------------------------------- 
    … …  
    335335   END SUBROUTINE tra_adv_tlm_tst 
    336336#endif 
     337#endif 
    337338 
    338339 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traldf_lap_tam.F90

    r1885 r2587  
    106106   PUBLIC tra_ldf_lap_adj      ! routine called by tradldf_tam.F90 
    107107   PUBLIC tra_ldf_lap_adj_tst  ! routine called by tradldf_tam.F90 
     108#if defined key_tst_tlm 
    108109   PUBLIC tra_ldf_lap_tlm_tst   
     110#endif 
    109111 
    110112   !! * Substitutions 
    … …  
    735737 
    736738   END SUBROUTINE tra_ldf_lap_adj_tst 
    737  
     739#if defined key_tst_tlm 
    738740   SUBROUTINE tra_ldf_lap_tlm_tst ( kumadt ) 
    739741      !!----------------------------------------------------------------------- 
    … …  
    775777        & lk_c1d 
    776778      USE par_tlm,    ONLY: & 
     779        & tlm_bch,          & 
    777780        & cur_loop,         & 
    778781        & h_ratio 
    779782      USE istate_mod 
    780       USE wzvmod             !  vertical velocity 
     783      USE zpshde 
    781784      USE gridrandom, ONLY: & 
    782785        & grid_rd_sd 
    … …  
    785788        & tb, sb, tn, sn, ta,  & 
    786789        & sa, gtu, gsu, gtv,   & 
    787         & gsv 
     790        & gsv, gru, grv, rhd 
    788791      USE traldf_lap          ! lateral mixing                   (tra_ldf routine) 
    789792      USE opatam_tst_ini, ONLY: & 
    … …  
    877880         & z2r               ! 2D random field  
    878881      CHARACTER(LEN=14) ::   cl_name 
    879       CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out 
     882      CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out, file_xdx 
    880883      CHARACTER (LEN=90) :: & 
    881884         & FMT 
    … …  
    972975      zgtv_wop(:,:)    = 0.0_wp 
    973976      zgsv_wop(:,:)    = 0.0_wp 
    974  
     977      IF ( tlm_bch == 2 ) THEN       
    975978      tb_tl(:,:,:) = 0.0_wp 
    976979      sb_tl(:,:,:) = 0.0_wp 
    … …  
    981984      gtv_tl(:,:)  = 0.0_wp 
    982985      gsv_tl(:,:)  = 0.0_wp 
    983  
     986      ENDIF 
    984987      zsctb(:)     = 0.0_wp 
    985988      zscta(:)     = 0.0_wp 
    … …  
    10021005      ! Output filename Xn=F(X0) 
    10031006      !-------------------------------------------------------------------- 
    1004       file_wop='trj_wop_tldf_lap' 
    10051007      CALL tlm_namrd 
    10061008      gamma = h_ratio 
     1009      file_wop='trj_wop_tldf_lap' 
     1010      file_xdx='trj_xdx_tldf_lap' 
    10071011      !-------------------------------------------------------------------- 
    10081012      ! Initialize the tangent input with random noise: dx 
    … …  
    10691073      ! Complete Init for Direct 
    10701074      !------------------------------------------------------------------- 
    1071       CALL istate_p   
     1075      IF ( tlm_bch /= 2 )      CALL istate_p   
    10721076 
    10731077      ! *** initialize the reference trajectory 
    … …  
    10761080      CALL  trj_rea( nit000, 1 ) 
    10771081 
     1082      ! Compute  gtu, gsu, gtv, gsv 
     1083      CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 
     1084 
    10781085      IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN 
    10791086         ztb_tlin(:,:,:) = gamma * ztb_tlin(:,:,:) 
    … …  
    11011108         gsv(:,:)       = gsv(:,:) + zgsv_tlin(:,:) 
    11021109      ENDIF  
    1103       IF( .NOT. lk_vvl ) CALL wzv(nit000) 
     1110 
    11041111      !-------------------------------------------------------------------- 
    11051112      !  Compute the direct model F(X0,t=n) = Xn 
    11061113      !-------------------------------------------------------------------- 
    1107       CALL tra_ldf_lap( nit000 ) 
    1108       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
    1109  
     1114      IF ( tlm_bch /= 2 )      CALL tra_ldf_lap( nit000 ) 
     1115      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1116      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    11101117      !-------------------------------------------------------------------- 
    11111118      !  Compute the Tangent  
    11121119      !-------------------------------------------------------------------- 
    1113       IF ( cur_loop .NE. 0) THEN 
    1114          !-------------------------------------------------------------------- 
    1115          !  Storing data 
    1116          !-------------------------------------------------------------------- 
    1117          ztb_out  (:,:,:) = tb   (:,:,:) 
    1118          zsb_out  (:,:,:) = sb   (:,:,:) 
    1119          zta_out  (:,:,:) = ta   (:,:,:) 
    1120          zsa_out  (:,:,:) = sa   (:,:,:) 
    1121          zgtu_out (:,:  ) = gtu  (:,:  )     
    1122          zgsu_out (:,:  ) = gsu  (:,:  ) 
    1123          zgtv_out (:,:  ) = gtv  (:,:  )     
    1124          zgsv_out (:,:  ) = gsv  (:,:  )       
    1125  
     1120      IF ( tlm_bch == 2 ) THEN     
    11261121         !-------------------------------------------------------------------- 
    11271122         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    11711166         zgtv_wop (:,:  ) = gtv (:,:  ) 
    11721167         zgsv_wop (:,:  ) = gsv (:,:  ) 
    1173  
     1168         CALL trj_rd_spl(file_xdx)  
     1169         ztb_out  (:,:,:) = tb  (:,:,:) 
     1170         zsb_out  (:,:,:) = sb  (:,:,:) 
     1171         zta_out  (:,:,:) = ta  (:,:,:) 
     1172         zsa_out  (:,:,:) = sa  (:,:,:) 
     1173         zgtu_out (:,:  ) = gtu (:,:  ) 
     1174         zgsu_out (:,:  ) = gsu (:,:  ) 
     1175         zgtv_out (:,:  ) = gtv (:,:  ) 
     1176         zgsv_out (:,:  ) = gsv (:,:  ) 
    11741177         !-------------------------------------------------------------------- 
    11751178         ! Compute the Linearization Error  
    … …  
    16281631      CALL iom_close( inum ) 
    16291632   END SUBROUTINE asm_trj_wop_rd 
    1630  
     1633#endif 
    16311634#endif 
    16321635   !!============================================================================== 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traldf_tam.F90

    r1885 r2587  
    1111   !!          9.0  ! 08-06 (A. Vidard) Skeleton 
    1212   !!          9.0  ! 09-03 (F. Vigilant) adding tra_ldf_lap option 
     13   !!          9.0  ! 10-06 (P.A. Bouttier) adding tra_ldf_bilap option 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    2526      & tra_ldf_lap_tan,     & 
    2627      & tra_ldf_lap_adj,     & 
    27       & tra_ldf_lap_adj_tst, & 
    28       & tra_ldf_lap_tlm_tst 
     28#if defined key_tst_tlm 
     29      & tra_ldf_lap_tlm_tst, & 
     30#endif 
     31      & tra_ldf_lap_adj_tst 
     32   USE traldf_bilap_tam, ONLY: & !lateral mixing                (tra_ldf_bilap routine) 
     33      & tra_ldf_bilap_tan,   & 
     34      & tra_ldf_bilap_adj 
    2935   USE in_out_manager, ONLY: & ! I/O manager 
    3036      & ctl_stop, nit000, lwp, numout, nitend 
    … …  
    5056   PUBLIC   tra_ldf_adj     ! called by step_tam.F90  
    5157   PUBLIC   tra_ldf_adj_tst ! called by tamtst.F90  
     58#if defined key_tst_tlm 
    5259   PUBLIC   tra_ldf_tlm_tst ! called by tamtst.F90  
     60#endif 
     61   PUBLIC   ldf_ctl_tam     ! called by trazdf_imp (init of l_traldf_rot) 
    5362 
    5463   INTEGER ::  nldf 
    … …  
    7685      CASE ( 0 )   ;   CALL tra_ldf_lap_tan   ( kt )      ! iso-level laplacian 
    7786      CASE ( 1 )   ;   CALL tra_ldf_iso_tan   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
     87      CASE ( 2 )   ;   CALL tra_ldf_bilap_tan ( kt )      ! iso-level bilaplacian 
    7888      END SELECT 
    7989   END SUBROUTINE tra_ldf_tan 
    … …  
    94104      CASE ( 0 )   ;   CALL tra_ldf_lap_adj   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
    95105      CASE ( 1 )   ;   CALL tra_ldf_iso_adj   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part) 
     106      CASE ( 2 )   ;   CALL tra_ldf_bilap_adj ( kt )      ! iso-level bilaplacian 
    96107      END SELECT 
    97108      ! 
    … …  
    206217 
    207218      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator 
    208            CALL ctl_stop( '          You shouldn t have seen this error message, ln_trad_bilap option not impemented yet for tam' ) 
     219         IF ( ln_zco ) THEN                ! z-coordinate 
     220            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation) 
     221            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
     222            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     223      ENDIF 
     224         IF ( ln_zps ) THEN             ! z-coordinate 
     225            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed  
     226            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation) 
     227            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
     228         ENDIF 
    209229      ENDIF 
    210230 
    211231      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
     232      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    212233      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   & 
    213234           CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    … …  
    227248   END SUBROUTINE ldf_ctl_tam 
    228249 
    229  
     250#if defined key_tst_tlm 
    230251   SUBROUTINE tra_ldf_tlm_tst( kumadt ) 
    231252      !!----------------------------------------------------------------------- 
    … …  
    266287   !!====================================================================== 
    267288#endif 
     289#endif 
    268290END MODULE traldf_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/tranxt_tam.F90

    r1885 r2587  
    229229      ! 
    230230   END SUBROUTINE tra_nxt_tan 
    231  
    232231   SUBROUTINE tra_nxt_adj( kt ) 
    233232      !!---------------------------------------------------------------------- 
    … …  
    476475      ! Reset the tangent and adjoint variables 
    477476      !-------------------------------------------------------------------- 
    478       zsa_tlin(:,:,:) = 0.0_wp  
    479       zta_tlin(:,:,:) = 0.0_wp  
    480       zsb_tlin(:,:,:) = 0.0_wp  
    481       ztb_tlin(:,:,:) = 0.0_wp  
    482       zsn_tlin(:,:,:) = 0.0_wp  
    483       ztn_tlin(:,:,:) = 0.0_wp  
    484       zsa_adin(:,:,:) = 0.0_wp  
    485       zta_adin(:,:,:) = 0.0_wp  
    486       zsb_adin(:,:,:) = 0.0_wp  
    487       ztb_adin(:,:,:) = 0.0_wp  
    488       zsn_adin(:,:,:) = 0.0_wp  
    489       ztn_adin(:,:,:) = 0.0_wp  
    490477      sb_tl(:,:,:) = 0.0_wp 
    491478      tb_tl(:,:,:) = 0.0_wp 
    … …  
    500487      sn_ad(:,:,:) = 0.0_wp 
    501488      tn_ad(:,:,:) = 0.0_wp 
     489      zsb_tlin(:,:,:) = 0.0_wp 
     490      ztb_tlin(:,:,:) = 0.0_wp 
     491      zsa_tlin(:,:,:) = 0.0_wp 
     492      zta_tlin(:,:,:) = 0.0_wp 
     493      zsn_tlin(:,:,:) = 0.0_wp 
     494      ztn_tlin(:,:,:) = 0.0_wp 
    502495 
    503496      DO jj = 1, jpj 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traqsr_tam.F90

    r1947 r2587  
    277277                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    278278                     ! qsr trend 
    279                      qsr_ad(ji,jj) = qsr_ad(ji,jj) + ta_ad(ji,jj,jk) * zc0   & 
    280                                    &   * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 
     279                     qsr_ad(ji,jj) = qsr_ad(ji,jj) + ta_ad(ji,jj,jk) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 
    281280                  END DO 
    282281               END DO 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trasbc_tam.F90

    r1885 r2587  
    9696   PUBLIC   tra_sbc_adj     ! routine called by step_tam.F90 
    9797   PUBLIC   tra_sbc_adj_tst ! routine called by tst.F90 
     98#if defined key_tst_tlm 
    9899   PUBLIC   tra_sbc_tlm_tst ! routine calle  by tamtst.F90 
     100#endif 
    99101 
    100102   !! * Substitutions 
    … …  
    579581   END SUBROUTINE tra_sbc_adj_tst 
    580582 
    581  
     583#if defined key_tst_tlm 
    582584   SUBROUTINE tra_sbc_tlm_tst ( kumadt )  
    583585      !!----------------------------------------------------------------------- 
    … …  
    612614      USE tamtrj              ! writing out state trajectory 
    613615      USE par_tlm,    ONLY: & 
     616        & tlm_bch,          & 
    614617        & cur_loop,         & 
    615618        & h_ratio 
    … …  
    676679         & zgsp7  
    677680      CHARACTER (LEN=14)  :: cl_name 
    678       CHARACTER (LEN=128) :: file_out, file_wop 
     681      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    679682      CHARACTER (LEN=90)  ::  FMT 
    680683      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    731734      ! Output filename Xn=F(X0) 
    732735      !-------------------------------------------------------------------- 
    733       file_wop='trj_wop_trasbc' 
    734736      CALL tlm_namrd 
    735737      gamma = h_ratio 
     738      file_wop='trj_wop_trasbc' 
     739      file_xdx='trj_xdx_trasbc' 
    736740      !-------------------------------------------------------------------- 
    737741      ! Initialize the tangent input with random noise: dx 
    … …  
    778782      ! Complete Init for Direct 
    779783      !------------------------------------------------------------------- 
    780       CALL istate_p   
     784      IF ( tlm_bch /= 2 )      CALL istate_p   
    781785 
    782786      ! *** initialize the reference trajectory 
    … …  
    804808      !  Compute the direct model F(X0,t=n) = Xn 
    805809      !-------------------------------------------------------------------- 
    806       CALL tra_sbc(nit000) 
    807  
    808       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
    809  
     810      IF ( tlm_bch /= 2 ) CALL tra_sbc(nit000) 
     811      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     812      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    810813      !-------------------------------------------------------------------- 
    811814      !  Compute the Tangent  
    812815      !-------------------------------------------------------------------- 
    813       IF ( cur_loop .NE. 0) THEN 
    814          !-------------------------------------------------------------------- 
    815          !  Storing data 
    816          !--------------------------------------------------------------------   
    817          zta_out  (:,:,:) = ta   (:,:,:) 
    818          zsa_out  (:,:,:) = sa   (:,:,:)           
    819  
     816      IF ( tlm_bch == 2 ) THEN          
    820817         !-------------------------------------------------------------------- 
    821818         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    836833         ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 
    837834         !-------------------------------------------------------------------- 
    838  
    839835         zsp2_1    = DOT_PRODUCT( ta_tl, ta_tl  ) 
    840836         zsp2_2    = DOT_PRODUCT( sa_tl, sa_tl  ) 
    … …  
    847843         zta_wop  (:,:,:) = ta  (:,:,:) 
    848844         zsa_wop  (:,:,:) = sa  (:,:,:) 
     845         CALL trj_rd_spl(file_xdx)  
     846         zta_out  (:,:,:) = ta  (:,:,:) 
     847         zsa_out  (:,:,:) = sa  (:,:,:) 
    849848         !-------------------------------------------------------------------- 
    850849         ! Compute the Linearization Error  
    … …  
    981980!!====================================================================== 
    982981#endif 
     982#endif 
    983983END MODULE trasbc_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trazdf_imp_tam.F90

    r1885 r2587  
    7474      & ahtw,                & 
    7575      & aht0 
     76#if defined key_ldfslp 
    7677   USE ldfslp        , ONLY: & ! lateral physics: slope of diffusion 
    7778      & wslpi,               & !: i_slope at W-points 
    7879      & wslpj                  !: j-slope at W-points 
     80#endif  
    7981#if defined key_zdfddm 
    8082   USE zdfddm        , ONLY: & 
    8183      & avs 
    8284#endif  
     85   USE traldf_tam 
    8386   USE in_out_manager, ONLY: & ! I/O manager  
    8487      & lwp,          & 
    … …  
    106109   PUBLIC tra_zdf_imp_adj       !  routine called by tra_zdf_adj.F90 
    107110   PUBLIC tra_zdf_imp_adj_tst   !  routine called by tst.F90 
     111#if defined key_tst_tlm 
    108112   PUBLIC tra_zdf_imp_tlm_tst   !  routine called by tamtst.F90  
     113#endif 
    109114 
    110115   !! * Substitutions 
    … …  
    483488      !!--------------------------------------------------------------------- 
    484489 
    485       IF( kt == nit000 ) THEN 
     490      IF( kt == nitend ) THEN 
    486491         IF(lwp)WRITE(numout,*) 
    487492         IF(lwp)WRITE(numout,*) 'tra_zdf_imp_adj : implicit vertical mixing' 
    488493         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~~~~ ' 
     494         CALL ldf_ctl_tam  ! init of l_traldf_rot 
    489495         zavi = 0._wp      ! avoid warning at compilation phase when lk_ldfslp=F 
    490496      ENDIF 
    … …  
    985991 
    986992   END SUBROUTINE tra_zdf_imp_adj_tst 
    987  
     993#if defined key_tst_tlm 
    988994   SUBROUTINE tra_zdf_imp_tlm_tst( kumadt ) 
    989995      !!----------------------------------------------------------------------- 
    … …  
    10191025      USE tamtrj              ! writing out state trajectory 
    10201026      USE par_tlm,    ONLY: & 
     1027        & tlm_bch,          & 
    10211028        & cur_loop,         & 
    10221029        & h_ratio 
    … …  
    10771084      CHARACTER(LEN=14) ::& 
    10781085         & cl_name 
    1079       CHARACTER (LEN=128) :: file_out, file_wop 
     1086      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    10801087      CHARACTER (LEN=90) :: & 
    10811088         & FMT 
    … …  
    11261133      ! Output filename Xn=F(X0) 
    11271134      !-------------------------------------------------------------------- 
    1128       file_wop='trj_wop_trazdf_imp' 
    11291135      CALL tlm_namrd 
    11301136      gamma = h_ratio 
     1137      file_wop='trj_wop_trazdf_imp' 
     1138      file_xdx='trj_xdx_trazdf_imp' 
    11311139      !-------------------------------------------------------------------- 
    11321140      ! Initialize the tangent input with random noise: dx 
    … …  
    11691177      ! Complete Init for Direct 
    11701178      !------------------------------------------------------------------- 
    1171       CALL istate_p   
     1179      IF ( tlm_bch /= 2 )      CALL istate_p   
    11721180 
    11731181      ! *** initialize the reference trajectory 
    … …  
    11921200      !  Compute the direct model F(X0,t=n) = Xn 
    11931201      !-------------------------------------------------------------------- 
    1194       CALL tra_zdf_imp(nit000, rdttra) 
    1195  
    1196       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
    1197  
     1202      IF ( tlm_bch /= 2 )  CALL tra_zdf_imp(nit000, rdttra) 
     1203      IF ( tlm_bch == 0 )  CALL trj_wri_spl(file_wop) 
     1204      IF ( tlm_bch == 1 )  CALL trj_wri_spl(file_xdx) 
    11981205      !-------------------------------------------------------------------- 
    11991206      !  Compute the Tangent  
    12001207      !-------------------------------------------------------------------- 
    1201       IF ( cur_loop .NE. 0) THEN 
    1202          !-------------------------------------------------------------------- 
    1203          !  Storing data 
    1204          !--------------------------------------------------------------------   
    1205          zta_out  (:,:,:) = ta   (:,:,:) 
    1206          zsa_out  (:,:,:) = sa   (:,:,:) 
     1208      IF ( tlm_bch == 2 ) THEN 
    12071209         !-------------------------------------------------------------------- 
    12081210         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    12351237         zta_wop  (:,:,:) = ta  (:,:,:) 
    12361238         zsa_wop  (:,:,:) = sa  (:,:,:) 
    1237  
     1239         CALL trj_rd_spl(file_xdx)  
     1240         zta_out  (:,:,:) = ta  (:,:,:) 
     1241         zsa_out  (:,:,:) = sa  (:,:,:) 
    12381242         !-------------------------------------------------------------------- 
    12391243         ! Compute the Linearization Error  
    … …  
    13781382   END SUBROUTINE tra_zdf_imp_tlm_tst 
    13791383#endif 
     1384#endif 
    13801385END MODULE trazdf_imp_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trazdf_tam.F90

    r1885 r2587  
    4646      & tra_zdf_imp_tan,     & 
    4747      & tra_zdf_imp_adj,     & 
    48       & tra_zdf_imp_adj_tst, & 
    49       & tra_zdf_imp_tlm_tst 
     48#if defined key_tst_tlm 
     49      & tra_zdf_imp_tlm_tst, & 
     50#endif 
     51      & tra_zdf_imp_adj_tst 
    5052   USE in_out_manager, ONLY: & ! I/O manager  
    5153      & lwp,                 & 
    … …  
    6365      & tra_zdf_tan, & 
    6466      & tra_zdf_adj         ! routines called by step_tam.F90 
    65    PUBLIC  & 
    66       & tra_zdf_adj_tst, &  ! routine called by tst.F90 
    67       & tra_zdf_tlm_tst     ! routine called by tst.F90  
     67   PUBLIC  tra_zdf_adj_tst  ! routine called by tst.F90 
     68#if defined key_tst_tlm 
     69   PUBLIC  tra_zdf_tlm_tst     ! routine called by tst.F90  
     70#endif 
    6871   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    6972      !                                ! defined from ln_zdf...  namlist logicals) 
    … …  
    247250 
    248251   END SUBROUTINE zdf_ctl_tam 
    249  
     252#if defined key_tst_tlm 
    250253   SUBROUTINE tra_zdf_tlm_tst( kumadt ) 
    251254      !!----------------------------------------------------------------------- 
    … …  
    282285   END SUBROUTINE tra_zdf_tlm_tst 
    283286#endif 
     287#endif 
    284288END MODULE trazdf_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/zpshde_tam.F90

    r1885 r2587  
    7878   PUBLIC zps_hde_adj      ! routine called by step_tam.F90 
    7979   PUBLIC zps_hde_adj_tst  ! routine called by tst.F90 
     80#if defined key_tst_tlm 
    8081   PUBLIC  zps_hde_tlm_tst ! routine called by tamtst.F90 
     82#endif 
    8183 
    8284   !! * module variables 
    … …  
    946948       
    947949   END SUBROUTINE zps_hde_adj_tst 
    948  
     950#if defined key_tst_tlm 
    949951   SUBROUTINE zps_hde_tlm_tst( kumadt ) 
    950952      !!----------------------------------------------------------------------- 
    … …  
    984986      USE tamtrj              ! writing out state trajectory 
    985987      USE par_tlm,    ONLY: & 
     988        & tlm_bch,          & 
    986989        & cur_loop,         & 
    987990        & h_ratio 
    … …  
    10491052         & zgsp7 
    10501053      CHARACTER(LEN=14)   :: cl_name 
    1051       CHARACTER (LEN=128) :: file_out, file_wop 
     1054      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    10521055      CHARACTER (LEN=90)  ::  FMT 
    10531056      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    11041107      zgru_out(:,:)   = 0.0_wp     
    11051108      zgrv_out(:,:)   = 0.0_wp 
     1109      IF ( tlm_bch == 2 ) THEN 
    11061110      gtu_tl(:,:)     = 0.0_wp 
    11071111      gtv_tl(:,:)     = 0.0_wp     
    … …  
    11101114      gru_tl(:,:)     = 0.0_wp     
    11111115      grv_tl(:,:)     = 0.0_wp  
    1112  
     1116      ENDIF 
    11131117      zscgtu(:)         = 0.0_wp 
    11141118      zscgtv(:)         = 0.0_wp 
    … …  
    11321136      ! Output filename Xn=F(X0) 
    11331137      !-------------------------------------------------------------------- 
    1134       file_wop='trj_wop_zps' 
    11351138      CALL tlm_namrd 
    11361139      gamma = h_ratio 
     1140      file_wop='trj_wop_zps' 
     1141      file_xdx='trj_xdx_zps' 
    11371142      !-------------------------------------------------------------------- 
    11381143      ! Initialize the tangent input with random noise: dx 
    … …  
    11671172      ! Complete Init for Direct 
    11681173      !------------------------------------------------------------------- 
    1169       CALL istate_p   
    1170  
     1174      IF ( tlm_bch /= 2 )  CALL istate_p   
    11711175      ! *** initialize the reference trajectory 
    11721176      ! ------------ 
    … …  
    11871191      !  Compute the direct model F(X0,t=n) = Xn 
    11881192      !-------------------------------------------------------------------- 
    1189       CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 
    1190  
    1191       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
    1192  
     1193      IF ( tlm_bch /= 2 ) CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 
     1194      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1195      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    11931196      !-------------------------------------------------------------------- 
    11941197      !  Compute the Tangent  
    11951198      !-------------------------------------------------------------------- 
    1196       IF ( cur_loop .NE. 0) THEN 
    1197          !-------------------------------------------------------------------- 
    1198          !  Storing data 
    1199          !--------------------------------------------------------------------   
    1200          zgtu_out  (:,:) = gtu   (:,:) 
    1201          zgtv_out  (:,:) = gtv   (:,:)   
    1202          zgsu_out  (:,:) = gsu   (:,:) 
    1203          zgsv_out  (:,:) = gsv   (:,:)  
    1204          zgru_out  (:,:) = gru   (:,:) 
    1205          zgrv_out  (:,:) = grv   (:,:)          
    1206  
     1199      IF ( tlm_bch == 2 ) THEN 
    12071200         !-------------------------------------------------------------------- 
    12081201         ! Initialize the tangent variables: 
    … …  
    12411234         zgru_wop  (:,:) = gru  (:,:) 
    12421235         zgrv_wop  (:,:) = grv  (:,:) 
     1236         CALL trj_rd_spl(file_xdx)  
     1237         zgtu_out  (:,:) = gtu  (:,:) 
     1238         zgtv_out  (:,:) = gtv  (:,:) 
     1239         zgsu_out  (:,:) = gsu  (:,:) 
     1240         zgsv_out  (:,:) = gsv  (:,:) 
     1241         zgru_out  (:,:) = gru  (:,:) 
     1242         zgrv_out  (:,:) = grv  (:,:) 
    12431243         !-------------------------------------------------------------------- 
    12441244         ! Compute the Linearization Error  
    … …  
    14711471   !!====================================================================== 
    14721472#endif 
     1473#endif 
    14731474END MODULE zpshde_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/cla_dynspg_tam.F90

    r1885 r2587  
    3131      & lwp,                 & 
    3232      & numout,              &   
    33       & nit000 
     33      & nit000,              & 
     34      & nitend 
    3435   USE dom_oce       , ONLY: & ! Ocean space and time domain 
    3536      & mi0,                 & 
    … …  
    330331      ! Control print 
    331332      ! ------------- 
    332       IF( kt == nit000 ) THEN  
     333      IF( kt == nitend ) THEN  
    333334         IF(lwp) WRITE(numout,*) 
    334335         IF(lwp) WRITE(numout,*) 'cla_dynspg_adj : cross land advection on surface ' 
    … …  
    486487      ! we convert in m3 
    487488      zempmed = zempmed * 1.e-3_wp 
    488  
    489 !!!! AW: Adjoint of this???? 
    490       IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value 
    491489 
    492490      ! minus 2 points in Red Sea and 3 in Atlantic  
    … …  
    504502      END DO 
    505503 
     504      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value 
     505 
    506506      ! compute the emp in Mediterranean Sea 
    507507      ij0 =  96   ;   ij1 = 110 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/dotprodfld.F90

    r1885 r2587  
    1010   !! * Modules used    
    1111   USE par_kind 
    12    USE dom_oce 
     12   USE dom_oce, ONLY :       & 
     13      & nldi,                & 
     14      & nldj,                & 
     15      & nlei,                & 
     16      & nlej 
     17   USE par_oce       , ONLY: & ! Ocean space and time domain variables 
     18      & jpi,                 & 
     19      & jpj,                 &  
     20      & jpk 
     21 
    1322   USE mppsumtam 
    1423 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/eosbn2_tam.F90

    r1885 r2587  
    130130   PUBLIC eos_adj_tst 
    131131   PUBLIC bn2_adj_tst 
     132#if defined key_tst_tlm 
    132133   PUBLIC eos_tlm_tst 
    133134   PUBLIC bn2_tlm_tst 
     135#endif 
    134136#endif 
    135137    
    … …  
    30573059 
    30583060   END SUBROUTINE bn2_adj_tst 
    3059  
     3061#if defined key_tst_tlm 
    30603062   SUBROUTINE eos_insitu_tlm_tst( kumadt ) 
    30613063      !!----------------------------------------------------------------------- 
    … …  
    30913093      USE tamtrj              ! writing out state trajectory 
    30923094      USE par_tlm,    ONLY: & 
     3095        & tlm_bch,          & 
    30933096        & cur_loop,         & 
    30943097        & h_ratio 
    … …  
    31343137         & jk 
    31353138      CHARACTER(LEN=14)   :: cl_name 
    3136       CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out 
     3139      CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out, file_xdx 
    31373140      CHARACTER (LEN=90)  :: FMT 
    31383141      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    31603163      zs_tlin(  :,:,:)   = 0.0_wp 
    31613164      zrd_out(  :,:,:)   = 0.0_wp  
    3162       zrd_tl (  :,:,:)   = 0.0_wp 
    31633165      zrd_wop(  :,:,:)   = 0.0_wp 
    31643166      zscerrrd(:)        = 0.0_wp 
    31653167      zscrd(:)           = 0.0_wp 
    3166  
     3168      IF ( tlm_bch == 2 ) zrd_tl (  :,:,:)   = 0.0_wp     
    31673169      !-------------------------------------------------------------------- 
    31683170      ! Output filename Xn=F(X0) 
    31693171      !-------------------------------------------------------------------- 
    3170       file_wop='trj_wop_eos_insitu' 
    31713172      CALL tlm_namrd 
    31723173      gamma = h_ratio 
     3174      file_wop='trj_wop_eos_insitu' 
     3175      file_xdx='trj_xdx_eos_insitu' 
    31733176      !-------------------------------------------------------------------- 
    31743177      ! Initialize the tangent input with random noise: dx 
    … …  
    31963199      ! Complete Init for Direct 
    31973200      !------------------------------------------------------------------- 
    3198       CALL istate_p   
     3201      IF ( tlm_bch /= 2 )  CALL istate_p   
    31993202 
    32003203      ! *** initialize the reference trajectory 
    … …  
    32133216      !  Compute the direct model F(X0,t=n) = Xn 
    32143217      !--------------------------------------------------------------------       
    3215       CALL eos(tn, sn, zrd_out) 
     3218      IF ( tlm_bch /= 2 )  CALL eos(tn, sn, zrd_out) 
    32163219      rhd(:,:,:)= zrd_out(:,:,:) 
    3217       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     3220      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     3221      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    32183222      !-------------------------------------------------------------------- 
    32193223      !  Compute the Tangent  
    32203224      !-------------------------------------------------------------------- 
    3221       IF ( cur_loop .NE. 0) THEN 
    3222          !-------------------------------------------------------------------- 
    3223          !  Storing data 
    3224          !-------------------------------------------------------------------- 
     3225      IF ( tlm_bch == 2 ) THEN 
    32253226         !-------------------------------------------------------------------- 
    32263227         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    32413242         CALL trj_rd_spl(file_wop)  
    32423243         zrd_wop  (:,:,:) = rhd  (:,:,:) 
    3243  
     3244         CALL trj_rd_spl(file_xdx)  
     3245         zrd_out  (:,:,:) = rhd  (:,:,:) 
    32443246         !-------------------------------------------------------------------- 
    32453247         ! Compute the Linearization Error  
    … …  
    33673369      USE tamtrj              ! writing out state trajectory 
    33683370      USE par_tlm,    ONLY: & 
     3371        & tlm_bch,          & 
    33693372        & cur_loop,         & 
    33703373        & h_ratio 
    … …  
    34163419         & jk 
    34173420      CHARACTER(LEN=14)   :: cl_name 
    3418       CHARACTER (LEN=128) :: file_out, file_wop 
     3421      CHARACTER (LEN=128) :: file_out, file_wop,file_xdx 
    34193422      CHARACTER (LEN=90)  :: FMT 
    34203423      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    34473450      zrd_out(  :,:,:)   = 0.0_wp 
    34483451      zrh_out(  :,:,:)   = 0.0_wp  
    3449       zrd_tl (  :,:,:)   = 0.0_wp 
    3450       zrh_tl (  :,:,:)   = 0.0_wp 
    34513452      zrd_wop(  :,:,:)   = 0.0_wp 
    34523453      zrh_wop(  :,:,:)   = 0.0_wp 
    … …  
    34553456      zscrd(:)           = 0.0_wp 
    34563457      zscrh(:)           = 0.0_wp 
    3457  
     3458      IF ( tlm_bch == 2 )  THEN 
     3459         zrd_tl (  :,:,:)   = 0.0_wp 
     3460         zrh_tl (  :,:,:)   = 0.0_wp 
     3461      ENDIF 
    34583462      !-------------------------------------------------------------------- 
    34593463      ! Output filename Xn=F(X0) 
    34603464      !-------------------------------------------------------------------- 
    3461       file_wop='trj_wop_eos_pot' 
    34623465      CALL tlm_namrd 
    34633466      gamma = h_ratio  
     3467      file_wop='trj_wop_eos_pot' 
     3468      file_xdx='trj_xdx_eos_pot' 
    34643469      !-------------------------------------------------------------------- 
    34653470      ! Initialize the tangent input with random noise: dx 
    … …  
    34863491      ! Complete Init for Direct 
    34873492      !------------------------------------------------------------------- 
    3488       CALL istate_p   
     3493      IF ( tlm_bch /= 2 )  CALL istate_p   
    34893494 
    34903495      ! *** initialize the reference trajectory 
    … …  
    35033508      !  Compute the direct model F(X0,t=n) = Xn 
    35043509      !--------------------------------------------------------------------       
    3505       CALL eos(tn, sn, zrd_out, zrh_out) 
     3510      IF ( tlm_bch /= 2 )      CALL eos(tn, sn, zrd_out, zrh_out) 
    35063511      rhd (:,:,:) = zrd_out(:,:,:) 
    35073512      rhop(:,:,:) = zrh_out(:,:,:) 
    3508       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     3513      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     3514      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    35093515      !-------------------------------------------------------------------- 
    35103516      !  Compute the Tangent  
    35113517      !-------------------------------------------------------------------- 
    3512       IF ( cur_loop .NE. 0) THEN 
    3513          !-------------------------------------------------------------------- 
    3514          !  Storing data 
    3515          !-------------------------------------------------------------------- 
     3518      IF ( tlm_bch == 2 ) THEN 
    35163519         !-------------------------------------------------------------------- 
    35173520         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    35363539         zrd_wop  (:,:,:) = rhd  (:,:,:) 
    35373540         zrh_wop  (:,:,:) = rhop (:,:,:) 
    3538  
     3541         CALL trj_rd_spl(file_xdx)  
     3542         zrd_out  (:,:,:) = rhd  (:,:,:) 
     3543         zrh_out  (:,:,:) = rhop (:,:,:) 
    35393544         !-------------------------------------------------------------------- 
    35403545         ! Compute the Linearization Error  
    … …  
    36953700      USE tamtrj              ! writing out state trajectory 
    36963701      USE par_tlm,    ONLY: & 
     3702        & tlm_bch,          & 
    36973703        & cur_loop,         & 
    36983704        & h_ratio 
    … …  
    37413747         & jj 
    37423748      CHARACTER(LEN=14)   :: cl_name 
    3743       CHARACTER (LEN=128) :: file_out, file_wop 
     3749      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    37443750      CHARACTER (LEN=90)  :: FMT 
    37453751      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    37713777      zs_tlin(  :,:)   = 0.0_wp 
    37723778      zrd_out(  :,:)   = 0.0_wp  
    3773       zrd_tl (  :,:)   = 0.0_wp 
    37743779      zrd_wop(  :,:)   = 0.0_wp 
    37753780      zscerrrd( :)     = 0.0_wp 
    37763781      zscrd(:)         = 0.0_wp 
    3777  
     3782      IF ( tlm_bch == 2 )      zrd_tl (  :,:)   = 0.0_wp 
    37783783      !-------------------------------------------------------------------- 
    37793784      ! Output filename Xn=F(X0) 
    37803785      !-------------------------------------------------------------------- 
    3781       file_wop='trj_wop_eos_2d' 
    3782  
    37833786      CALL tlm_namrd 
    37843787      gamma = h_ratio 
     3788      file_wop='trj_wop_eos_2d' 
     3789      file_xdx='trj_xdx_eos_2d' 
    37853790      !-------------------------------------------------------------------- 
    37863791      ! Initialize the tangent input with random noise: dx 
    … …  
    38043809      ! Complete Init for Direct 
    38053810      !------------------------------------------------------------------- 
    3806       CALL istate_p   
     3811      IF ( tlm_bch /= 2 ) CALL istate_p   
    38073812      ! *** initialize the reference trajectory 
    38083813      ! ------------ 
    … …  
    38243829      !  Compute the direct model F(X0,t=n) = Xn 
    38253830      !--------------------------------------------------------------------     
    3826       CALL eos(ztem, zsal, zdep, zrd_out) 
     3831      IF ( tlm_bch /= 2 ) CALL eos(ztem, zsal, zdep, zrd_out) 
    38273832      rhd (:,:,2) = zrd_out(:,:) 
    3828       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     3833      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     3834      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    38293835      !-------------------------------------------------------------------- 
    38303836      !  Compute the Tangent  
    38313837      !-------------------------------------------------------------------- 
    3832       IF ( cur_loop .NE. 0) THEN 
    3833          !-------------------------------------------------------------------- 
    3834          !  Storing data 
    3835          !-------------------------------------------------------------------- 
     3838      IF ( tlm_bch == 2 ) THEN 
    38363839         !-------------------------------------------------------------------- 
    38373840         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    38543857         CALL trj_rd_spl(file_wop)  
    38553858         zrd_wop  (:,:) = rhd  (:,:,2) 
     3859         CALL trj_rd_spl(file_xdx)  
     3860         zrd_out  (:,:) = rhd  (:,:,2) 
    38563861         !-------------------------------------------------------------------- 
    38573862         ! Compute the Linearization Error  
    … …  
    39763981      USE tamtrj              ! writing out state trajectory 
    39773982      USE par_tlm,    ONLY: & 
     3983        & tlm_bch,          & 
    39783984        & cur_loop,         & 
    39793985        & h_ratio 
    … …  
    40234029         & z3r                 
    40244030      CHARACTER(LEN=14)   :: cl_name 
    4025       CHARACTER (LEN=128) :: file_out, file_wop 
     4031      CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 
    40264032      CHARACTER (LEN=90)  :: FMT 
    40274033      REAL(KIND=wp), DIMENSION(100):: & 
    … …  
    40514057      ! Output filename Xn=F(X0) 
    40524058      !-------------------------------------------------------------------- 
    4053       file_wop='trj_wop_bn2' 
    4054  
    40554059      CALL tlm_namrd 
    40564060      gamma = h_ratio     
     4061      file_wop='trj_wop_bn2' 
     4062      file_xdx='trj_xdx_bn2'   
    40574063      !-------------------------------------------------------------------- 
    40584064      ! Initialize the tangent input with random noise: dx 
    … …  
    40794085      ! Complete Init for Direct 
    40804086      !------------------------------------------------------------------- 
    4081       CALL istate_p   
     4087      IF ( tlm_bch /= 2 ) CALL istate_p   
    40824088 
    40834089      ! *** initialize the reference trajectory 
    … …  
    40984104      !  Compute the direct model F(X0,t=n) = Xn 
    40994105      !-------------------------------------------------------------------- 
    4100       CALL bn2(tn, sn, rn2) 
    4101       IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
     4106      IF ( tlm_bch /= 2 ) CALL bn2(tn, sn, rn2) 
     4107      IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     4108      IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    41024109      !-------------------------------------------------------------------- 
    41034110      !  Compute the Tangent  
    41044111      !-------------------------------------------------------------------- 
    4105       IF ( cur_loop .NE. 0) THEN 
    4106          !-------------------------------------------------------------------- 
    4107          !  Storing data 
    4108          !-------------------------------------------------------------------- 
    4109          zrn2_out  (:,:,:) = rn2   (:,:,:)          
    4110  
     4112      IF ( tlm_bch == 2 ) THEN 
    41114113         !-------------------------------------------------------------------- 
    41124114         ! Initialize the tangent variables: dy^* = W dy   
    … …  
    41314133         CALL trj_rd_spl(file_wop)  
    41324134         zrn2_wop  (:,:,:) = rn2  (:,:,:) 
    4133  
     4135         CALL trj_rd_spl(file_xdx)  
     4136         zrn2_out  (:,:,:) = rn2  (:,:,:) 
    41344137         !-------------------------------------------------------------------- 
    41354138         ! Compute the Linearization Error  
    … …  
    42444247   END SUBROUTINE eos_tlm_tst 
    42454248#endif 
     4249#endif 
    42464250   !!====================================================================== 
    42474251END MODULE eosbn2_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/istate_tam.F90

    r1885 r2587  
    4545#  endif 
    4646# endif 
    47       & tmask, umask, vmask 
     47      & tmask, umask, vmask, & 
     48      & n_cla 
    4849   USE daymod        , ONLY: & 
    4950      & day_init 
    … …  
    6162   USE eosbn2_tam    , ONLY: & 
    6263      & eos_tan, eos_adj 
     64   USE divcur_tam    , ONLY: & 
     65      & div_cur_tan, div_cur_adj 
     66   USE cla_div_tam    , ONLY: & 
     67      & div_cla_tan, div_cla_adj 
    6368   USE tstool_tam    , ONLY: & 
    6469      & prntst_adj,          & 
    … …  
    119124      sb_tl   (:,:,:) = sn_tl   (:,:,:) 
    120125      sshb_tl (  :,:) = sshn_tl (  :,:) 
    121       rotb_tl (:,:,:) = rotn_tl (:,:,:)   
     126      ! 
     127      rotb_tl (:,:,:) = rotn_tl (:,:,:)   ! Update before fields 
    122128      hdivb_tl(:,:,:) = hdivn_tl(:,:,:)   
    123       ! 
    124129 
    125130 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/mpp_tam.F90

    r1885 r2587  
    4747      & mpp_sum_reals,      & 
    4848      & mpp_global_or,      & 
    49       & mpp_global_max_real 
     49      & mpp_global_max_real, & 
     50      & mpp_global_max_real2 
    5051 
    5152CONTAINS 
    … …  
    151152   SUBROUTINE mpp_global_max_real( zin, zout ) 
    152153      !!---------------------------------------------------------------------- 
    153       !!               ***  ROUTINE mpp_global_or *** 
     154      !!               ***  ROUTINE mpp_global_max_real *** 
    154155      !!           
    155156      !! ** Purpose : Copy a local zin array to a global array and 
    … …  
    213214   END SUBROUTINE mpp_global_max_real 
    214215 
     216 
     217   SUBROUTINE mpp_global_max_real2( zin, zout ) 
     218      !!---------------------------------------------------------------------- 
     219      !!               ***  ROUTINE mpp_global_max_real2 *** 
     220      !!           
     221      !! ** Purpose : Copy a local zin array to a global array and 
     222      !!              apply the "max" operation for all elements in 
     223      !!              a global (jpiglo,jpjglo) array across processors 
     224      !! 
     225      !! ** Method  : MPI allreduce 
     226      !! 
     227      !! ** Action  : This does only work for MPI.  
     228      !!              It does not work for SHMEM. 
     229      !! 
     230      !! References : http://www.mpi-forum.org 
     231      !! 
     232      !! History : 
     233      !!        !  08-01  (K. Mogensen)  Original code 
     234      !!---------------------------------------------------------------------- 
     235 
     236      !! * Arguments 
     237      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: & 
     238         & zin 
     239      REAL(wp), DIMENSION(jpiglo,jpjglo), INTENT(OUT) :: & 
     240         & zout 
     241      !! * Local declarations 
     242      INTEGER :: & 
     243         & ierr 
     244#if defined key_mpp_mpi 
     245#include <mpif.h> 
     246      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
     247         & zcp 
     248      INTEGER :: & 
     249         & ji, & 
     250         & jj 
     251       
     252      ! Copy data for input to MPI 
     253 
     254      ALLOCATE( & 
     255         & zcp(jpiglo,jpjglo) & 
     256         & ) 
     257      zcp(:,:) = -1e+38 
     258      DO jj = nldj, nlej 
     259         DO ji = nldi, nlei 
     260            zcp(mig(ji),mjg(jj)) = zin(ji,jj) 
     261         ENDDO 
     262      ENDDO 
     263 
     264      ! Call the MPI library to find the coast lines globally 
     265 
     266      CALL mpi_allreduce( zcp, zout, jpiglo*jpjglo, mpivar, & 
     267         &                mpi_max, mpi_comm_opa, ierr ) 
     268 
     269      DEALLOCATE( & 
     270         & zcp & 
     271         & ) 
     272 
     273#elif defined key_mpp_shmem 
     274#error "Only MPI support for MPP in NEMOVAR" 
     275#else 
     276      zout(:,:) = zin(:,:) 
     277#endif 
     278       
     279   END SUBROUTINE mpp_global_max_real2 
     280    
    215281END MODULE mpp_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/nemotam.F90

    r1885 r2587  
    2828   USE phycst          ! physical constant                  (par_cst routine) 
    2929   USE tamtrj          ! handling of the trajectory 
     30   USE trj_tam         ! handling of the trajectory 
    3031   USE tamctl          ! Control parameters 
    3132   USE oce_tam         ! TL and adjoint data 
    … …  
    3334   USE trc_oce_tam     ! Trend tangent and adjoint arrays 
    3435   USE sol_oce_tam     ! Solver tangent and adjoint arrays 
    35    USE tamtst          ! Gradient testing 
     36   USE tamtst 
    3637   ! ocean physics 
    3738#if defined key_tam 
    … …  
    4142   USE zdfini  
    4243 
     44#if defined key_tst_tlm 
    4345#if defined key_tam 
    4446   USE opatam_tst_ini, ONLY :  & 
    … …  
    4749     & opatam_4_tst_ini 
    4850#endif 
     51#endif 
    4952 
    5053   IMPLICIT NONE 
    … …  
    109112      !! * Local declarations 
    110113      CHARACTER (len=128) :: file_out = 'nemovar.output' 
    111       CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemovar'  
     114      CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemotam'  
    112115      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    113116         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp 
    … …  
    127130 
    128131      ! Nodes selection 
    129       narea = mynode() 
    130       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
     132      nproc = mynode() 
     133      narea = nproc + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    131134      lwp   = narea == 1 
     135      ln_rstart = .FALSE. 
    132136 
    133137      ! open additionnal listing 
    … …  
    185189      CALL     tam_trj_ini 
    186190 
     191      CALL day_init 
    187192      CALL day( nit000 ) 
    188193 
    … …  
    204209 
    205210      !! * Local declarations 
    206       NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, & 
    207          &             ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, & 
    208          &             ln_tst_tan_cpd, ln_tst_tan 
     211      NAMELIST/namtst/ ln_tst_nemotam, ln_tst_cpd_tam, ln_tst_stp_tam, & 
     212         &             ln_tst_tan_cpd, ln_tst_tan, ln_tst_stop 
    209213 
    210214      REAL(wp) :: & 
    … …  
    241245      i_flag_rc = 0 
    242246 
    243       ln_tst         = .TRUE. 
    244       ln_tst_obsadj  = .FALSE. 
    245       ln_tst_bkgadj  = .FALSE. 
    246247      ln_tst_nemotam = .FALSE. 
    247       ln_tst_grad    = .FALSE. 
    248248      ln_tst_cpd_tam = .FALSE. 
    249249      ln_tst_stp_tam = .FALSE. 
    250250      ln_tst_tan_cpd = .FALSE. 
    251251      ln_tst_tan     = .FALSE. 
     252      ln_tst_stop    = .FALSE. 
    252253 
    253254      REWIND( numnam ) 
    … …  
    258259         WRITE(numout,*) ' namtst' 
    259260         WRITE(numout,*) ' ' 
    260          WRITE(numout,*) ' master switch for operator tests     ln_tst = ',ln_tst 
    261          WRITE(numout,*) ' switch for H adjoint tests    ln_tst_obsadj = ',ln_tst_obsadj 
    262          WRITE(numout,*) ' switch for B adjoint tests    ln_tst_bkgadj = ',ln_tst_bkgadj 
    263261         WRITE(numout,*) ' switch for M adjoint tests   ln_tst_nemotam = ',ln_tst_nemotam 
    264          WRITE(numout,*) ' switch for gradient test        ln_tst_grad = ',ln_tst_grad 
     262         WRITE(numout,*) ' stop after tests                ln_tst_stop = ',ln_tst_stop 
    265263         WRITE(numout,*) ' ' 
    266264 
    … …  
    269267      ! B.4 Tests 
    270268 
    271       IF ( ln_tst ) CALL tstopt 
     269      IF ( ln_tst_nemotam ) CALL tsttam 
    272270 
    273271   END SUBROUTINE nemotam_sub 
    … …  
    296294      IF ( lk_mpp ) CALL mppsync 
    297295 
     296      ! Deallocate variables 
     297      ! -------------------- 
     298      CALL oce_tam_deallocate ( 0 ) 
     299      CALL sol_oce_tam_deallocate ( 0 ) 
     300#if defined key_tam 
     301      CALL sbc_oce_tam_deallocate ( 0 ) 
     302      CALL trc_oce_tam_deallocate ( 0 ) 
     303#endif 
     304      CALL trj_deallocate 
    298305      ! Unit close 
    299306      ! ---------- 
    … …  
    301308      CLOSE( numnam )       ! namelist 
    302309      CLOSE( numout )       ! standard model output file 
    303       IF ( .NOT. lini ) THEN 
     310      IF ( lini ) THEN 
    304311         CLOSE( numtan_sc )    ! tangent test diagnostic output 
    305312         CLOSE( numtan )       ! tangent diagnostic output 
    … …  
    349356      !!---------------------------------------------------------------------- 
    350357      !! * Local declarations 
    351       NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, & 
    352          &             ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, & 
    353          &             ln_tst_tan_cpd, ln_tst_tan 
     358      NAMELIST/namtst/ ln_tst_nemotam, ln_tst_cpd_tam, ln_tst_stp_tam, & 
     359         &             ln_tst_tan_cpd, ln_tst_tan, ln_tst_stop 
    354360      CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemotam' 
    355361      !! * Arguments 
    356362 
    357       ln_tst         = .TRUE. 
    358       ln_tst_obsadj  = .FALSE. 
    359       ln_tst_bkgadj  = .FALSE. 
    360363      ln_tst_nemotam = .FALSE. 
    361       ln_tst_grad    = .FALSE. 
    362364      ln_tst_cpd_tam = .FALSE. 
    363365      ln_tst_stp_tam = .FALSE. 
    364366      ln_tst_tan_cpd = .FALSE. 
    365367      ln_tst_tan     = .FALSE. 
     368      ln_tst_stop    = .TRUE. 
    366369 
    367370      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    … …  
    372375 
    373376      IF ( ln_tst_tan ) THEN 
     377#if defined key_tst_tlm 
    374378         CALL  opa_opatam_ini 
    375379         lini = .FALSE.            ! not standard initialisation 
     380#else 
     381         CALL ctl_stop( 'Activate key_tst_tlm for ln_tst_tan=.true.' ) 
     382#endif 
    376383      ELSE 
    377384         CALL nemotam_init 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/oce_tam.F90

    r1885 r2587  
    3434   PUBLIC & 
    3535      & oce_tam_init, & !: Initialize the TAM fields 
     36      & oce_tam_deallocate, & 
    3637                    !: 
    3738      & ub_tl,    & !: Tangent linear of before u-component velocity 
    … …  
    788789 
    789790   END SUBROUTINE oce_tam_init 
     791   SUBROUTINE oce_tam_deallocate ( kindic ) 
     792      !!----------------------------------------------------------------------- 
     793      !! 
     794      !!                  ***  ROUTINE oce_tam_deallocate  *** 
     795      !! 
     796      !! ** Purpose : Deallocate the tangent linear and  
     797      !!              adjoint arrays 
     798      !! 
     799      !! ** Method  : kindic = 0  deallocate both tl and ad variables 
     800      !!              kindic = 1  deallocate only tl variables 
     801      !!              kindic = 2  deallocate only ad variables 
     802      !! 
     803      !! ** Action  : 
     804      !!                    
     805      !! References :  
     806      !! 
     807      !! History : 
     808      !!        ! 2010-06 (A. Vidard) initial version 
     809      !!----------------------------------------------------------------------- 
     810      !! * Arguments 
     811      INTEGER, INTENT(IN) :: & 
     812         & kindic        ! indicate which variables to allocate/initialize 
     813       
     814      !! * Local declarations 
     815      ! Dellocate tangent linear variable arrays 
     816      ! --------------------------------------- 
     817       
     818      IF ( kindic == 0 .OR. kindic == 1 ) THEN 
     819 
     820         IF ( ALLOCATED(ub_tl) ) DEALLOCATE( ub_tl ) 
     821 
     822         IF ( ALLOCATED(un_tl) ) DEALLOCATE( un_tl ) 
     823 
     824         IF ( ALLOCATED(ua_tl) ) DEALLOCATE( ua_tl ) 
     825 
     826         IF ( ALLOCATED(vb_tl) ) DEALLOCATE( vb_tl ) 
     827 
     828         IF ( ALLOCATED(vn_tl) ) DEALLOCATE( vn_tl ) 
     829 
     830         IF ( ALLOCATED(va_tl) ) DEALLOCATE( va_tl ) 
     831 
     832         IF ( ALLOCATED(wn_tl) ) DEALLOCATE( wn_tl ) 
     833 
     834         IF ( ALLOCATED(rotb_tl) ) DEALLOCATE( rotb_tl ) 
     835             
     836         IF ( ALLOCATED(rotn_tl) ) DEALLOCATE( rotn_tl ) 
     837             
     838         IF ( ALLOCATED(hdivb_tl) ) DEALLOCATE( hdivb_tl ) 
     839 
     840         IF ( ALLOCATED(hdivn_tl) ) DEALLOCATE( hdivn_tl ) 
     841             
     842         IF ( ALLOCATED(tb_tl) ) DEALLOCATE( tb_tl ) 
     843             
     844         IF ( ALLOCATED(tn_tl) ) DEALLOCATE( tn_tl ) 
     845 
     846         IF ( ALLOCATED(ta_tl) ) DEALLOCATE( ta_tl ) 
     847             
     848         IF ( ALLOCATED(sb_tl) ) DEALLOCATE( sb_tl ) 
     849 
     850         IF ( ALLOCATED(sn_tl) ) DEALLOCATE( sn_tl ) 
     851 
     852         IF ( ALLOCATED(sa_tl) ) DEALLOCATE( sa_tl ) 
     853             
     854         IF ( ALLOCATED(rhd_tl) ) DEALLOCATE( rhd_tl ) 
     855             
     856         IF ( ALLOCATED(rhop_tl) ) DEALLOCATE( rhop_tl ) 
     857 
     858         IF ( ALLOCATED(rn2_tl) ) DEALLOCATE( rn2_tl ) 
     859 
     860         IF ( ALLOCATED(spgu_tl) ) DEALLOCATE( spgu_tl ) 
     861             
     862         IF ( ALLOCATED(spgv_tl) ) DEALLOCATE( spgv_tl ) 
     863             
     864#if defined key_dynspg_rl 
     865         IF ( ALLOCATED(bsfb_tl) ) DEALLOCATE( bsfb_tl ) 
     866          
     867         IF ( ALLOCATED(bsfn_tl) ) DEALLOCATE( bsfn_tl ) 
     868          
     869         IF ( ALLOCATED(bsfd_tl) ) DEALLOCATE( bsfd_tl ) 
     870          
     871#else 
     872         IF (ALLOCATED(sshb_tl) ) DEALLOCATE( sshb_tl ) 
     873 
     874         IF (ALLOCATED(sshn_tl) ) DEALLOCATE( sshn_tl ) 
     875 
     876         IF (ALLOCATED(ssha_tl) ) DEALLOCATE( ssha_tl ) 
     877 
     878         IF (ALLOCATED(sshu_tl) ) DEALLOCATE( sshu_tl ) 
     879 
     880         IF (ALLOCATED(sshv_tl) ) DEALLOCATE( sshv_tl ) 
     881 
     882         IF (ALLOCATED(sshbb_tl) ) DEALLOCATE( sshbb_tl ) 
     883 
     884#endif       
     885         IF ( ALLOCATED(gtu_tl) ) DEALLOCATE( gtu_tl ) 
     886 
     887         IF ( ALLOCATED(gtv_tl) ) DEALLOCATE( gtv_tl ) 
     888 
     889         IF ( ALLOCATED(gsu_tl) ) DEALLOCATE( gsu_tl ) 
     890 
     891         IF ( ALLOCATED(gsv_tl) ) DEALLOCATE( gsv_tl ) 
     892 
     893         IF ( ALLOCATED(gru_tl) ) DEALLOCATE( gru_tl ) 
     894 
     895         IF ( ALLOCATED(grv_tl) ) DEALLOCATE( grv_tl ) 
     896 
     897 
     898 
     899#if defined key_zdfddm 
     900!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     901!!!!  AW: The declaration/allocation/initialization of these variables 
     902!!!!      should be moved to a new module zdf_ddm_tam_init to be consistent 
     903!!!!      with NEMO. 
     904         IF ( ALLOCATED(rrau_tl) ) DEALLOCATE( rrau_tl ) 
     905             
     906 
     907!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     908#endif 
     909 
     910 
     911      ENDIF 
     912 
     913      IF ( kindic == 0 .OR. kindic == 2 ) THEN 
     914 
     915         ! Allocate adjoint variable arrays 
     916         ! -------------------------------- 
     917       
     918         IF ( ALLOCATED(ub_ad) ) DEALLOCATE( ub_ad ) 
     919 
     920         IF ( ALLOCATED(un_ad) ) DEALLOCATE( un_ad ) 
     921 
     922         IF ( ALLOCATED(ua_ad) ) DEALLOCATE( ua_ad ) 
     923 
     924         IF ( ALLOCATED(vb_ad) ) DEALLOCATE( vb_ad ) 
     925 
     926         IF ( ALLOCATED(vn_ad) ) DEALLOCATE( vn_ad ) 
     927 
     928         IF ( ALLOCATED(va_ad) ) DEALLOCATE( va_ad ) 
     929 
     930         IF ( ALLOCATED(wn_ad) ) DEALLOCATE( wn_ad ) 
     931             
     932         IF ( ALLOCATED(rotb_ad) ) DEALLOCATE( rotb_ad ) 
     933 
     934         IF ( ALLOCATED(rotn_ad) ) DEALLOCATE( rotn_ad ) 
     935 
     936         IF ( ALLOCATED(hdivb_ad) ) DEALLOCATE( hdivb_ad ) 
     937 
     938         IF ( ALLOCATED(hdivn_ad) ) DEALLOCATE( hdivn_ad ) 
     939 
     940         IF ( ALLOCATED(tb_ad) ) DEALLOCATE( tb_ad ) 
     941             
     942         IF ( ALLOCATED(tn_ad) ) DEALLOCATE( tn_ad ) 
     943 
     944         IF ( ALLOCATED(ta_ad) ) DEALLOCATE( ta_ad ) 
     945 
     946         IF ( ALLOCATED(sb_ad) ) DEALLOCATE( sb_ad ) 
     947             
     948         IF ( ALLOCATED(sn_ad) ) DEALLOCATE( sn_ad ) 
     949             
     950         IF ( ALLOCATED(sa_ad) ) DEALLOCATE( sa_ad ) 
     951             
     952         IF ( ALLOCATED(rhd_ad) ) DEALLOCATE( rhd_ad ) 
     953             
     954         IF ( ALLOCATED(rhop_ad) ) DEALLOCATE( rhop_ad ) 
     955             
     956         IF ( ALLOCATED(rn2_ad) ) DEALLOCATE( rn2_ad ) 
     957 
     958         IF ( ALLOCATED(spgu_ad) ) DEALLOCATE( spgu_ad ) 
     959 
     960         IF ( ALLOCATED(spgv_ad) ) DEALLOCATE( spgv_ad ) 
     961 
     962#if defined key_dynspg_rl 
     963         IF ( ALLOCATED(bsfb_ad) ) DEALLOCATE( bsfb_ad ) 
     964          
     965         IF ( ALLOCATED(bsfn_ad) ) DEALLOCATE( bsfn_ad ) 
     966 
     967         IF ( ALLOCATED(bsfd_ad) ) DEALLOCATE( bsfd_ad ) 
     968 
     969#else 
     970         IF ( ALLOCATED(sshb_ad) ) DEALLOCATE( sshb_ad ) 
     971 
     972         IF ( ALLOCATED(sshn_ad) ) DEALLOCATE( sshn_ad ) 
     973 
     974         IF ( ALLOCATED(ssha_ad) ) DEALLOCATE( ssha_ad ) 
     975 
     976         IF ( ALLOCATED(sshu_ad) ) DEALLOCATE( sshu_ad ) 
     977 
     978         IF ( ALLOCATED(sshv_ad) ) DEALLOCATE( sshv_ad ) 
     979 
     980         IF ( ALLOCATED(sshbb_ad) ) DEALLOCATE( sshbb_ad ) 
     981 
     982#endif       
     983         IF ( ALLOCATED(gtu_ad) ) DEALLOCATE( gtu_ad ) 
     984 
     985         IF ( ALLOCATED(gtv_ad) ) DEALLOCATE( gtv_ad ) 
     986 
     987         IF ( ALLOCATED(gsu_ad) ) DEALLOCATE( gsu_ad ) 
     988 
     989         IF ( ALLOCATED(gsv_ad) ) DEALLOCATE( gsv_ad ) 
     990 
     991         IF ( ALLOCATED(gru_ad) ) DEALLOCATE( gru_ad ) 
     992 
     993         IF ( ALLOCATED(grv_ad) ) DEALLOCATE( grv_ad ) 
     994 
     995 
     996 
     997#if defined key_zdfddm 
     998!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     999!!!!  AW: The declaration/allocation/initialization of these variables 
     1000!!!!      should be moved to a new module zdf_ddm_tam_init to be consistent 
     1001!!!!      with NEMO. 
     1002         IF ( ALLOCATED(rrau_ad) ) DEALLOCATE( rrau_ad ) 
     1003!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     1004#endif 
     1005 
     1006      ENDIF 
     1007 
     1008   END SUBROUTINE oce_tam_deallocate 
    7901009       
    7911010END MODULE oce_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/opatam_tst_init.F90

    r2586 r2587  
    11MODULE opatam_tst_ini 
    22#if defined key_tam 
     3#if defined key_tst_tlm 
    34   !!============================================================================== 
    45   !!                       ***  MODULE opatam_tst_init   *** 
    … …  
    6768   ! ocean physics 
    6869   USE zdfini  
    69 !   USE nemotam, ONLY: &  
    70 !      & nemotam_banner   
    7170   USE opa 
     71   USE par_tlm 
    7272 
    7373   IMPLICIT NONE 
    … …  
    100100      !!---------------------------------------------------------------------- 
    101101 
    102 !       CALL opa_model 
     102      ! Initialization 
     103      CALL opa_hdr_ini 
     104      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     105      CALL opa_flg                          ! Control prints & Benchmark 
     106      CALL tlm_namrd 
     107 
     108      SELECT CASE (tlm_bch) 
     109         CASE ( 0, 1 ) 
    103110      CALL  opa_4_tst_ini 
     111         CASE ( 2 ) 
    104112      CALL  opatam_4_tst_ini 
     113         CASE DEFAULT 
     114            CALL ctl_stop( '        Wrong Value of tlm_bch') 
     115      END SELECT 
     116 
    105117 
    106118   END SUBROUTINE opa_opatam_ini 
    … …  
    120132      INTEGER ::   itro, istp0        ! ??? 
    121133#endif 
    122 !!#if defined key_oasis3 || defined key_oasis4 
    123 !!      INTEGER :: localComm 
    124 !!#endif 
    125 !!      CHARACTER (len=20) ::   namelistname 
    126 !!      CHARACTER (len=28) ::   file_out 
    127 !!      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    128 !!         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp 
    129       !!---------------------------------------------------------------------- 
    130134 
    131135      ! Initializations 
    132136      ! =============== 
    133  
    134       CALL opa_hdr_ini 
    135137 
    136138      !                                     ! ============================== ! 
    137139      !                                     !  Model general initialization  ! 
    138140      !                                     ! ============================== ! 
    139  
    140       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    141  
    142       CALL opa_flg                          ! Control prints & Benchmark 
    143141 
    144142                                            ! Domain decomposition 
    … …  
    183181#endif 
    184182 
    185       CALL dia_ptr_init                     ! Poleward Transports initialization 
    186183      IF(lwp) WRITE(numout,*)'Euler time step switch is ', neuler 
    187184      ldirinit = .TRUE. 
    188185 
    189186      CALL     tam_trj_ini 
    190       !                                     ! =============== ! 
    191       !                                     !  time stepping  ! 
    192       !                                     ! =============== ! 
     187 
     188      CALL day_init 
     189      CALL day(nit000) 
    193190 
    194191      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    … …  
    232229      WRITE(numout,*) 
    233230 
    234 ! Already opened in nemotam_root 
    235 !      namelistname = 'namelist.nemovar' 
    236 !      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    237 !         &         1, numout, .FALSE., 1 ) 
    238  
    239231      ! Namelist namctl : Control prints & Benchmark 
    240232      REWIND( numnam ) 
    … …  
    247239#else 
    248240      ! Nodes selection 
    249       narea = mynode() 
     241      nproc = mynode() 
     242      narea = nproc + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    250243#endif 
    251244      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    … …  
    255248!      IF( ln_ctl )   THEN 
    256249         IF( narea-1 > 0 )   THEN 
    257             WRITE(file_out,FMT="('nemovar.output_',I4.4)") narea-1 
     250            WRITE(file_out,FMT="('nemotam_tst.output_',I4.4)") narea-1 
    258251            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    259252               &         'SEQUENTIAL', 1, numout, .FALSE., 1 ) 
    … …  
    292285      !! * Local declarations 
    293286      CHARACTER (len=128) :: file_out !!= 'nemovar.output' 
    294 !!      CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemovar' 
    295 !!      NAMELIST/namctl/ ln_ctl, nprint, nbit_cmp, nabortx, ln_smslabel, & 
    296 !!         &             nn_smsfrq 
    297  
    298       ! open listing and namelist units 
    299 !!      CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    300 !!         &         'SEQUENTIAL', 1, numout, .FALSE., 1 ) 
    301 !!      CALL nemotam_banner( numout ) 
    302  
    303 !!      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    304 !!         &           1, numout, .FALSE., 1 ) 
    305  
    306       ! Namelist namctl : Control prints & Benchmark 
    307 !!      REWIND( numnam ) 
    308 !!      READ  ( numnam, namctl ) 
    309  
    310       IF ( .NOT. ldirinit) CALL opa_hdr_ini      ! Initialization 
     287 
    311288 
    312289      ! Nodes selection 
    313       narea = mynode() 
    314       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
     290      nproc = mynode() 
     291      narea = nproc + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    315292      lwp   = narea == 1 
    316293 
    … …  
    349326      IF (lwp) THEN 
    350327         ! Diagnostic file for tangent test 
    351 !         WRITE(file_out,FMT="('tan_diag.output_',I4.4)") , narea-1 
     328         WRITE(file_out,FMT="('tan_diag.output_',I4.4)") , narea-1 
    352329         CALL ctlopn( numtan, file_out, 'UNKNOWN', 'FORMATTED',   & 
    353330            &         'SEQUENTIAL', 1, numtan, .FALSE., 1 ) 
    … …  
    363340      IF (lwp) THEN 
    364341         ! Diagnostic file for tangent test (scalar sampling) 
    365 !         WRITE(file_out,FMT="('tan_diag_sc.output_',I4.4)") , narea-1 
     342         WRITE(file_out,FMT="('tan_diag_sc.output_',I4.4)") , narea-1 
    366343         CALL ctlopn( numtan_sc, file_out, 'UNKNOWN', 'FORMATTED',   & 
    367344            &         'SEQUENTIAL', 1, numtan_sc, .FALSE., 1 ) 
    … …  
    398375 
    399376      IF ( .NOT. ldirinit) CALL     tam_trj_ini 
     377 
     378      CALL day_init 
    400379      IF ( .NOT. ldirinit) CALL day( nit000 ) 
    401380 
    … …  
    403382 
    404383#endif 
     384      neuler=1 
    405385 
    406386      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    … …  
    575555      & numnam,                 & 
    576556      & lwp 
    577       USE par_tlm,    ONLY: & 
    578         & cur_loop,         & 
    579         & h_ratio 
    580557      !! * Local declarations 
    581558 
    582       NAMELIST/namtst_tlm/ cur_loop, h_ratio 
     559      NAMELIST/namtst_tlm/ tlm_bch, cur_loop, h_ratio 
    583560 
    584561      ! Read Namelist namflg : algorithm FLaG 
    … …  
    594571         WRITE(numout,*) '~~~~~~~~~' 
    595572         WRITE(numout,*) '          Namelist namtst_tlm : set algorithm parameters' 
     573         WRITE(numout,*) '             current branch test     = ' , tlm_bch 
    596574         WRITE(numout,*) '             current loop iteration  = ' , cur_loop 
    597575         WRITE(numout,*) '             current h_ratio applied = ' , h_ratio 
    … …  
    603581   !!====================================================================== 
    604582#endif 
     583#endif 
    605584END MODULE opatam_tst_ini 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/ran_num.F90

    r1885 r2587  
    1313   USE dom_oce        ! Domain variables 
    1414   USE in_out_manager ! I/O stuff 
     15   USE mt19937ar, ONLY : & 
     16    & init_mtrand,       & 
     17    & mtrand_real1 
    1518 
    1619   IMPLICIT NONE 
    … …  
    118121        
    119122   END FUNCTION gausva 
    120  
    121    FUNCTION psrandom( kdum )  
    122       !!---------------------------------------------------------------------- 
    123       !!               ***  ROUTINE psrandom *** 
    124       !!           
    125       !! ** Purpose : Pseudo-Random number generator. 
    126       !! 
    127       !! ** Method  : Returns a pseudo-random number from a uniform distribution 
    128       !!              between 0 and 1 
    129       !!              Call with kdum a negative integer to initialize. 
    130       !!              Thereafter, do not alter kdum between successive deviates  
    131       !!              in sequence. 
    132       !! 
    133       !! ** Action  :  
    134       !! 
    135       !! History : 
    136       !!        !  10-02  (F. Vigilant)  Original code  
    137       !!---------------------------------------------------------------------- 
    138       !! * Function return 
    139       REAL(wp) ::  & 
    140          & psrandom 
    141       !! * Arguments 
    142       INTEGER, INTENT(INOUT) :: & 
    143          & kdum          ! Seed 
    144       LOGICAL, SAVE :: & 
    145          & llinit = .FALSE. 
    146  
    147       ! Initialization 
    148       IF ( .NOT. llinit ) THEN 
    149           
    150          CALL srand( kdum ) 
    151          llinit     = .TRUE. 
    152           
    153       ENDIF 
    154  
    155       CALL rand(psrandom)  
    156  
    157    END FUNCTION psrandom 
    158     
    159123 
    160124   FUNCTION gaustb_2d( ki, kj, kseed, pamp, pmean  ) 
    … …  
    241205      IF ( niset(ki,kj) == 0 ) THEN 
    242206 
    243          zv1   = 2.0_wp * psrandom_2d( ki, kj, kdum ) - 1.0_wp 
    244          zv2   = 2.0_wp * psrandom_2d( ki, kj, kdum ) - 1.0_wp 
     207         zv1   = 2.0_wp * psrandom( kdum(ki,kj) ) - 1.0_wp 
     208         zv2   = 2.0_wp * psrandom( kdum(ki,kj) ) - 1.0_wp 
    245209         zrsq  = zv1**2 + zv2**2 
    246210 
    247211         DO WHILE ( ( zrsq >= 1.0_wp ) .OR. ( zrsq == 0.0_wp ) )  
    248212 
    249             zv1   = 2.0_wp * psrandom_2d( ki, kj, kdum ) - 1.0_wp 
    250             zv2   = 2.0_wp * psrandom_2d( ki, kj, kdum ) - 1.0_wp 
     213            zv1   = 2.0_wp * psrandom( kdum(ki,kj) ) - 1.0_wp 
     214            zv2   = 2.0_wp * psrandom( kdum(ki,kj) ) - 1.0_wp 
    251215            zrsq  = zv1**2 + zv2**2 
    252216 
    … …  
    267231   END FUNCTION gausva_2d 
    268232 
    269    FUNCTION psrandom_2d( ki, kj, kdum )  
    270       !!---------------------------------------------------------------------- 
    271       !!               ***  ROUTINE psrandom_2d *** 
    272       !!           
    273       !! ** Purpose : Random number generator. 
     233   FUNCTION psrandom( kdum ) 
     234      !!---------------------------------------------------------------------- 
     235      !!               ***  ROUTINE psrandom *** 
     236      !!           
     237      !! ** Purpose : Pseudo-Random number generator. 
    274238      !! 
    275239      !! ** Method  : Returns a pseudo-random number from a uniform distribution 
    … …  
    286250      !! * Function return 
    287251      REAL(wp) ::  & 
    288          & psrandom_2d 
    289       !! * Arguments 
    290       INTEGER, INTENT(IN) :: & 
    291          & ki, &         ! Indices in seed array 
    292          & kj 
    293       INTEGER, INTENT(INOUT), DIMENSION(jpi,jpj) :: & 
     252         & psrandom 
     253      !! * Arguments 
     254      INTEGER, INTENT(INOUT) :: & 
    294255         & kdum          ! Seed 
    295256      LOGICAL, SAVE :: & 
    296257         & llinit = .FALSE. 
     258      INTEGER :: & 
     259   & kdum1, & 
     260   & kdum2 
    297261 
    298262      ! Initialization 
    299263      IF ( .NOT. llinit ) THEN 
    300           
    301          CALL srand( kdum( ki,kj ) ) 
     264    kdum2 = 596035 
     265    kdum1 = kdum + nproc * kdum2 
     266         CALL init_mtrand(kdum) 
    302267         llinit     = .TRUE. 
    303           
    304       ENDIF 
    305  
    306       CALL rand(psrandom_2d)   
     268      ENDIF 
     269 
     270      psrandom = mtrand_real1() 
    307271       
    308    END FUNCTION psrandom_2d 
     272   END FUNCTION psrandom 
     273 
    309274 
    310275END MODULE ran_num 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/step_tam.F90

    r1885 r2587  
    4343      & tb, sb, tn, sn, ta,  & 
    4444      & un, vn, sshn, sshb,  & 
    45       & sa, ub, vb,          & 
     45      & sa, ub, vb, rn2,     & 
    4646      & ln_dynhpg_imp 
    4747   USE zdfkpp        , ONLY: & 
    … …  
    7676      &  ln_traqsr 
    7777          ! solar radiation penetration flag 
     78   USE asminc 
     79   USE asmbkg 
    7880   USE oce_tam       , ONLY: & ! Tangent linear and adjoint variables 
    7981      & oce_tam_init,        & 
    … …  
    134136   USE wzvmod_tam      ! vertical velocity                (adjoint of wzv     routine) 
    135137 
    136    USE zdfkpp_tam     ! KPP vertical mixing 
    137  
     138!!   USE zdfkpp_tam     ! KPP vertical mixing 
     139   USE zdf_oce, ONLY : lk_zdfcst, avt, avt0, avmu, avmv, avm0, ln_zdfevd         ! KPP vertical mixing 
     140   USE zdfddm, ONLY  : &            ! double diffusion mixing          (zdf_ddm routine) 
     141      & lk_zdfddm,     & 
     142      & zdf_ddm   
     143   USE zdfevd, only:zdf_evd         ! double diffusion mixing          (zdf_ddm routine) 
     144   USE zdfbfr, only:zdf_bfr         ! double diffusion mixing          (zdf_ddm routine) 
     145   USE zdfmxl, only:zdf_mxl         ! double diffusion mixing          (zdf_ddm routine) 
     146   USE eosbn2, ONLY: bn2 
    138147   USE zpshde_tam      ! partial step: hor. derivative     (adjoint of zps_hde routine) 
    139148 
    … …  
    186195   PUBLIC stp_tan,      & 
    187196      &   stp_adj,      & ! called by simvar.F90 
     197#if defined key_tst_tlm 
    188198      &   stp_tlm_tst,  & 
     199#endif 
    189200      &   stp_adj_tst 
    190201 
    … …  
    257268      ! Output the initial state and forcings ... not needed in tangent 
    258269 
    259       ! saving direct variables ua,va, ta, sa before entering in tracer 
    260       zta_tmp (:,:,:) = ta (:,:,:) 
    261       zsa_tmp (:,:,:) = sa (:,:,:) 
    262270      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    263271      ! Ocean physics update 
    … …  
    315323 
    316324#endif 
    317  
    318       ta (:,:,:) = zta_tmp (:,:,:) 
    319       sa (:,:,:) = zsa_tmp (:,:,:) 
    320325      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    321326      ! Active tracers 
    … …  
    11841189 
    11851190   END SUBROUTINE stp_adj_tst 
    1186  
     1191#if defined key_tst_tlm 
    11871192   SUBROUTINE stp_tlm_tst( kumadt ) 
    11881193      !!----------------------------------------------------------------------- 
    … …  
    12281233        & lk_c1d 
    12291234      USE par_tlm,    ONLY: & 
     1235        & tlm_bch,          & 
    12301236        & cur_loop,         & 
    12311237        & h_ratio 
    … …  
    12621268         & zgsp1, zgsp2, zgsp3, zgsp4, zgsp5,     & 
    12631269         & zgsp6, zgsp7      
     1270      REAL(KIND=wp) ::       &   
     1271         & zgsp1_U, zgsp1_V, zgsp1_T, zgsp1_S, zgsp1_SSH,     & 
     1272         & zgsp4_U, zgsp4_V, zgsp4_T, zgsp4_S, zgsp4_SSH,      & 
     1273         & zgsp5_U, zgsp5_V, zgsp5_T, zgsp5_S, zgsp5_SSH      
    12641274      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    12651275         & ta_tmp   ,        & 
    … …  
    12881298  
    12891299      CHARACTER(LEN=14)   :: cl_name 
    1290       CHARACTER (LEN=128) :: file_out, file_wop, file_wop2 
     1300      CHARACTER (LEN=128) :: file_out, file_wop, file_wop2, file_xdx 
    12911301      CHARACTER (LEN=90)  :: FMT 
    12921302 
    … …  
    13881398      ! Output filename Xn=F(X0) 
    13891399      !-------------------------------------------------------------------- 
    1390       file_wop='trj_wop_step' 
    13911400      CALL tlm_namrd 
    13921401      gamma = h_ratio 
     1402      file_wop='trj_wop_step' 
     1403      file_xdx='trj_xdx_step' 
    13931404      !-------------------------------------------------------------------- 
    13941405      ! Initialize the tangent input with random noise: dx 
    … …  
    14501461          ENDIF 
    14511462     ENDIF  
    1452      CALL istate_p  
     1463     IF ( tlm_bch /= 2 )  CALL istate_p  
    14531464 
    14541465         !-------------------------------------------------------------------- 
    … …  
    14561467         !-------------------------------------------------------------------- 
    14571468 
    1458      PRINT*,'IN TST_STP h_ratio, cur_loop, gamma', h_ratio, ' ',cur_loop,' ', gamma 
    1459      Call flush(numout) 
    1460   
    14611469      ! check that all process are still there... If some process have an error, 
    14621470      ! they will never enter in step and other processes will wait until the end of the cpu time! 
    … …  
    14641472 
    14651473        istp = nit000 
     1474        IF ( tlm_bch /= 2 )  THEN 
    14661475        IF( lk_c1d ) THEN                 ! 1D configuration (no AGRIF zoom) 
    1467         ! 
    14681476           DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    14691477              CALL stp_c1d( istp ) 
    14701478              istp = istp + 1 
    14711479           END DO 
    1472         ELSE 
    1473            istp = nit000 - 1                 
    1474            IF( ln_trjwri ) CALL tam_trj_wri( istp )    ! Output trajectory fields 
     1480        ENDIF 
    14751481        ENDIF 
    14761482 
    … …  
    14971503        !  Compute the direct model F(X0,t=n) = Xn 
    14981504        !-------------------------------------------------------------------- 
     1505        IF ( tlm_bch /= 2 )  THEN 
    14991506        DO istp = nit000, nitend, 1 
    15001507           CALL stp( istp ) 
    15011508        END DO 
    1502         IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 
    1503  
     1509        ENDIF 
     1510        IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 
     1511        IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 
    15041512        !-------------------------------------------------------------------- 
    15051513        !  Compute the Tangent  
    15061514        !-------------------------------------------------------------------- 
    1507         IF ( cur_loop .NE. 0) THEN 
    1508  
    1509            !-------------------------------------------------------------------- 
    1510            !  Storing data 
    1511            !-------------------------------------------------------------------- 
    1512            zun_out   (:,:,:) = un   (:,:,:) 
    1513            zvn_out   (:,:,:) = vn   (:,:,:) 
    1514            ztn_out   (:,:,:) = tn   (:,:,:) 
    1515            zsn_out   (:,:,:) = sn   (:,:,:) 
    1516            zsshn_out (:,:  ) = sshn (:,:  )          
     1515        IF ( tlm_bch == 2 ) THEN         
    15171516 
    15181517           !-------------------------------------------------------------------- 
    … …  
    15201519           !-------------------------------------------------------------------- 
    15211520           qrp_tl = 0.0_wp 
    1522  
     1521#if defined key_tradmp 
     1522           strdmp_tl = 0.0_wp 
     1523           ttrdmp_tl = 0.0_wp 
     1524#endif 
    15231525           a_fwb_tl = 0.0_wp 
    15241526 
    … …  
    15351537           !  Initialization of the dynamics and tracer fields for the tangent 
    15361538           !----------------------------------------------------------------------- 
     1539 
    15371540           CALL istate_init_tan  
     1541  
    15381542           DO istp = nit000, nitend, 1 
    15391543              CALL stp_tan( istp ) 
     1544              !CALL stp_tan_cpd( istp ) 
    15401545           END DO 
    15411546        
    … …  
    15561561           !-------------------------------------------------------------------- 
    15571562           CALL trj_rd_spl(file_wop) 
    1558  
    15591563           zun_wop   (:,:,:) = un   (:,:,:) 
    15601564           zvn_wop   (:,:,:) = vn   (:,:,:) 
    … …  
    15621566           zsn_wop   (:,:,:) = sn   (:,:,:) 
    15631567           zsshn_wop (:,:  ) = sshn (:,:  )   
     1568           CALL trj_rd_spl(file_xdx)  
     1569           zun_out   (:,:,:) = un   (:,:,:) 
     1570           zvn_out   (:,:,:) = vn   (:,:,:) 
     1571           ztn_out   (:,:,:) = tn   (:,:,:) 
     1572           zsn_out   (:,:,:) = sn   (:,:,:) 
     1573           zsshn_out (:,:  ) = sshn (:,:  ) 
    15641574           !-------------------------------------------------------------------- 
    15651575           ! Compute the Linearization Error  
    … …  
    17111721         zzsp_SSH = SQRT(zsp3_SSH) 
    17121722         zgsp5    = zzsp 
     1723         zgsp5_U=zzsp_U 
     1724         zgsp5_V=zzsp_V 
     1725         zgsp5_T=zzsp_T 
     1726         zgsp5_S=zzsp_S 
     1727         zgsp5_SSH=zzsp_SSH 
    17131728         CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) 
    17141729 
    … …  
    17291744         zzsp_SSH =  SQRT(zsp2_SSH) 
    17301745         zgsp4    = zzsp 
     1746         zgsp4_U=zzsp_U 
     1747         zgsp4_V=zzsp_V 
     1748         zgsp4_T=zzsp_T 
     1749         zgsp4_S=zzsp_S 
     1750         zgsp4_SSH=zzsp_SSH 
    17311751         cl_name = 'step_tam:Ln2  ' 
    17321752         CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) 
    … …  
    17611781         zgsp7    = zgsp3/gamma 
    17621782         zgsp1    = zzsp 
     1783         zgsp1_U=zzsp_U 
     1784         zgsp1_V=zzsp_V 
     1785         zgsp1_T=zzsp_T 
     1786         zgsp1_S=zzsp_S 
     1787         zgsp1_SSH=zzsp_SSH 
    17631788         zgsp2    = zgsp1 / zgsp4 
    17641789         zgsp6    = (zgsp2 - 1.0_wp)/gamma 
    17651790 
    17661791         FMT = "(A8,2X,I4.4,2X,E6.1,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13,2X,E20.13)" 
    1767          WRITE(numtan,FMT) 'step    ', cur_loop, h_ratio, zgsp1, zgsp2, zgsp3, zgsp4, zgsp5, zgsp6, zgsp7 
    1768  
     1792 
     1793         WRITE(numtan,FMT) 'step    ', cur_loop, h_ratio, zgsp1, zgsp1_T ,zgsp4_T, zgsp5_T,zgsp1_S,zgsp4_S,zgsp5_S!, 
    17691794         !-------------------------------------------------------------------- 
    17701795         ! Unitary calculus 
    … …  
    19211946   !!====================================================================== 
    19221947#endif 
     1948#endif 
    19231949END MODULE step_tam 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/stpctl_tam.F90

    r1885 r2587  
    161161         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax 
    162162      ENDIF 
    163 !      IF( zumax > 100.) THEN 
    164       IF( zumax > 500.) THEN 
     163      IF( zumax > 50.) THEN 
    165164         IF( lk_mpp ) THEN 
    166165            CALL mpp_maxloc(ABS(un_tl),umask,zumax,ii,ij,ik) 
    … …  
    173172         IF(lwp) THEN 
    174173            WRITE(numout,cform_err) 
    175             WRITE(numout,*) ' stpctl_tan: the zonal velocity is larger than 20 m/s' 
     174            WRITE(numout,*) ' stpctl_tan: the zonal velocity is larger than 50 m/s' 
    176175            WRITE(numout,*) ' ========= ' 
    177176            WRITE(numout,9400) kt, zumax, ii, ij, ik 
    … …  
    197196         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(V) max: ', zvmax 
    198197      ENDIF 
    199 !      IF( zvmax > 100.) THEN 
    200       IF( zvmax > 500.) THEN 
     198      IF( zvmax > 50.) THEN 
    201199         IF( lk_mpp ) THEN 
    202200            CALL mpp_maxloc(ABS(vn_tl),vmask,zvmax,ii,ij,ik) 
    … …  
    209207         IF(lwp) THEN 
    210208            WRITE(numout,cform_err) 
    211             WRITE(numout,*) ' stpctl_tan: the meridional  velocity is larger than 10 m/s' 
     209            WRITE(numout,*) ' stpctl_tan: the meridional  velocity is larger than 50 m/s' 
    212210            WRITE(numout,*) ' ========= ' 
    213211            WRITE(numout,9410) kt, zvmax, ii, ij, ik 
    … …  
    232230         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(T) max: ', zTmax 
    233231      ENDIF 
    234 !      IF( ztmax > 300.) THEN 
    235       IF( ztmax > 600.) THEN 
     232      IF( ztmax > 80.) THEN 
    236233         IF( lk_mpp ) THEN 
    237234            CALL mpp_maxloc(ABS(tn_tl),tmask,ztmax,ii,ij,ik) 
    … …  
    244241         IF(lwp) THEN 
    245242            WRITE(numout,cform_err) 
    246             WRITE(numout,*) ' stpctl_tan: the temperature is larger than 30 K' 
     243            WRITE(numout,*) ' stpctl_tan: the temperature is larger than 80 K' 
    247244            WRITE(numout,*) ' ========= ' 
    248245            WRITE(numout,9420) kt, ztmax, ii, ij, ik 
    … …  
    268265         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(S) max: ', zsmax 
    269266      ENDIF 
    270 !      IF( zsmax > 200.) THEN 
    271       IF( zsmax > 600.) THEN 
     267      IF( zsmax > 100.) THEN 
    272268         IF( lk_mpp ) THEN 
    273269            CALL mpp_maxloc(ABS(sn_tl),tmask,zsmax,ii,ij,ik) 
    … …  
    280276         IF(lwp) THEN 
    281277            WRITE(numout,cform_err) 
    282             WRITE(numout,*) ' stpctl_tan: the Salinity is larger than 20 o/oo' 
     278            WRITE(numout,*) ' stpctl_tan: the Salinity is larger than 100 o/oo' 
    283279            WRITE(numout,*) ' ========== ' 
    284280            WRITE(numout,9430) kt, zsmax, ii, ij, ik 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/tamctl.F90

    r1885 r2587  
    3333 
    3434   LOGICAL :: & 
    35       & ln_tst,         & ! Master switch for operator tests 
    36       & ln_tst_obsadj,  & ! Switch for observation operator adjoint test 
    37       & ln_tst_bkgadj,  & ! Switch for bkg error covariance operator adjoint test 
    3835      & ln_tst_nemotam, & ! Switch for NEMOTAM adjoint tests 
    39       & ln_tst_grad,    & ! Switch for gradient test 
    4036      & ln_tst_cpd_tam, & ! Switch for NEMOTAM adjoint tests (components only) 
    4137      & ln_tst_stp_tam, & ! Switch for STEP_TAM adjoint tests 
    4238      & ln_tst_tan_cpd, & ! Switch for NEMOTAM tangent components accuracy tests  
    43       & ln_tst_tan        ! Switch for NEMOTAM tangent accuracy tests 
     39      & ln_tst_tan,     & ! Switch for NEMOTAM tangent accuracy tests 
     40      & ln_tst_stop       ! Stop after tests or not 
    4441 
    4542 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/tamtst.F90

    r1885 r2587  
    5454#endif 
    5555 
     56   USE step_tam_cpd        ! Temporary 
     57 
    5658   IMPLICIT NONE 
    5759 
    … …  
    6062 
    6163   PUBLIC & 
    62       & tstopt, &          !: Scalar product test of the adjoint routines 
     64      & tsttam, &          !: Scalar product test of the adjoint routines 
    6365      & numadt             !: File unit number for adjoint test output 
    6466 
    … …  
    6971CONTAINS 
    7072 
    71    SUBROUTINE tstopt 
     73   SUBROUTINE tsttam 
    7274      !!----------------------------------------------------------------------- 
    7375      !! 
    74       !!                  ***  ROUTINE tstopt  *** 
     76      !!                  ***  ROUTINE tsttam  *** 
    7577      !! 
    76       !! ** Purpose : Apply various tests (linearization, adjoint, gradient) 
    77       !!              on the NEMOVAR code. 
     78      !! ** Purpose : Apply various tests (linearization, adjoint) 
     79      !!              on the NEMOTAM code. 
    7880      !! 
    7981      !! ** Method  :  
    … …  
    8587      !!        ! 07-11 (A. Weaver) Add adjoint tests 
    8688      !!        ! 09-03 (I. Mirouze) Filter call depends on type 
    87       !!        ! 09-08 (F. Vigilant) Add tangent tests 
     89      !!        ! 09-08 (F. Vigilant) Split TAM and Var and add tangent tests 
    8890      !!----------------------------------------------------------------------- 
    8991      !! * Modules used 
    … …  
    133135      CALL par_esp 
    134136 
    135       ! --------------------------------------------------------------- 
    136       ! 1) Test the adjoint of the components of B 
    137       ! --------------------------------------------------------------- 
    138  
    139       ! Moved to NEMOVAR 
    140  
    141       ! ----------------------------------------------------- 
    142       ! 2) Test the adjoint of H 
    143       ! ----------------------------------------------------- 
    144  
    145       ! Moved to NEMOVAR 
    146  
    147137#if defined key_tam 
    148       ! ----------------------------------------------------- 
    149       ! 3) Test the adjoint of the simplification operator 
    150       ! ----------------------------------------------------- 
    151  
    152       ! Not yet implemented 
    153  
    154       ! ----------------------------------------------------- 
    155       ! 4) Test the adjoint of the components of M (NEMOTAM) 
    156       ! ----------------------------------------------------- 
    157138 
    158139      IF ( ln_tst_nemotam ) THEN 
    159140 
    160141         IF ( ln_tst_cpd_tam ) THEN 
     142            ! ----------------------------------------------------- 
     143            ! 1) Test the adjoint of the components of M (NEMOTAM) 
     144            ! ----------------------------------------------------- 
    161145            ! *** initialize the reference trajectory 
    162146            ! ------------ 
    … …  
    206190            IF (lwp) WRITE(numadt,*) 
    207191 
    208             IF( lk_dynspg_rl ) & 
    209                 & CALL dyn_spg_adj_tst( numadt )    ! Surface pressure gradient 
     192            CALL dyn_spg_adj_tst( numadt )    ! Surface pressure gradient 
    210193 
    211194            IF (lwp) WRITE(numadt,*) 
    … …  
    292275         ENDIF 
    293276 
    294          ! *** Time-loop operator 
    295          ! ---------------------- 
     277         ! ----------------------------------------------------- 
     278         ! 2) Test the adjoint of of M (NEMOTAM) 
     279         ! ----------------------------------------------------- 
    296280         IF ( ln_tst_stp_tam ) THEN 
    297281 
    … …  
    303287 
    304288         ENDIF 
    305  
    306          ! *** Tangent accuracy 
     289#if defined key_tst_tlm 
     290         ! ----------------------------------------------------- 
     291         ! 3)  Test the Tangent accuracy 
    307292         ! ---------------------- 
    308293         IF ( ln_tst_tan ) THEN      
    … …  
    310295            IF (ln_tst_tan_cpd) THEN 
    311296 
    312                CALL flush(numout) 
    313  
    314297               CALL dyn_hpg_tlm_tst( numadt ) 
    315298 
    316                CALL flush(numout) 
    317  
    318                IF( lk_dynspg_rl ) & 
    319                   & CALL dyn_spg_tlm_tst( numadt ) 
    320  
    321                CALL flush(numout) 
     299               CALL dyn_spg_tlm_tst( numadt ) 
     300 
     301               CALL sol_sor_tlm_tst( numadt ) 
    322302 
    323303               CALL zps_hde_tlm_tst( numadt ) 
    324304 
    325                CALL flush(numout) 
    326  
    327305               CALL tra_sbc_tlm_tst( numadt ) 
    328306 
    329                CALL flush(numout) 
    330  
    331307               CALL dyn_adv_tlm_tst( numadt ) 
    332308 
    333                CALL flush(numout) 
    334  
    335309               CALL eos_tlm_tst( numadt ) 
    336310 
    337                CALL flush(numout) 
    338  
    339311               CALL bn2_tlm_tst( numadt ) 
    340312 
    341                CALL flush(numout) 
    342  
    343313               CALL tra_zdf_tlm_tst( numadt ) 
    344314 
    345                CALL flush(numout) 
    346  
    347315               CALL tra_adv_tlm_tst( numadt )        
    348316 
    349                CALL flush(numout) 
    350              
    351317               CALL tra_ldf_tlm_tst( numadt )  
    352318        
    353                CALL flush(numout) 
    354319            ELSE 
    355320 
    … …  
    363328 
    364329         ENDIF 
    365  
     330#endif 
    366331      ENDIF 
    367332#endif 
    … …  
    372337      IF (lwp) THEN 
    373338         WRITE(numout,*) 
    374          WRITE(numout,*) ' tstopt: Finished testing operators' 
     339         WRITE(numout,*) ' tsttam: Finished testing operators' 
    375340         WRITE(numout,*) ' ------' 
    376341         WRITE(numout,*) 
    377342      ENDIF 
    378343      CALL flush(numout) 
    379    END SUBROUTINE tstopt 
     344   END SUBROUTINE tsttam 
    380345 
    381346END MODULE tamtst 

  • branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/trc_oce_tam.F90

    r1885 r2587  
    3737   PUBLIC & 
    3838      & trc_oce_tam_init, & !: Initialize the trend TAM fields 
     39      & trc_oce_tam_deallocate, & !: Deallocate the trend TAM fields 
    3940      & etot3_tl, & 
    4041      & etot3_ad 
    … …  
    103104 
    104105   END SUBROUTINE trc_oce_tam_init 
     106   SUBROUTINE trc_oce_tam_deallocate( kindic ) 
     107      !!----------------------------------------------------------------------- 
     108      !! 
     109      !!                  ***  ROUTINE trc_oce_tam_deallocate  *** 
     110      !! 
     111      !! ** Purpose : Deallocate the tangent linear and 
     112      !!              adjoint arrays 
     113      !! 
     114      !! ** Method  : kindic = 0  deallocate both tl and ad variables 
     115      !!              kindic = 1  deallocate only tl variables 
     116      !!              kindic = 2  deallocate only ad variables 
     117      !! 
     118      !! ** Action  : 
     119      !! 
     120      !! References : 
     121      !! 
     122      !! History : 
     123      !!        ! 2010-06 (A. Vidard) Initial version 
     124      !!----------------------------------------------------------------------- 
     125      !! * Arguments 
     126      INTEGER, INTENT(IN) :: & 
     127         & kindic        ! indicate which variables to deallocate 
    105128 
     129      !! * Local declarations 
     130      ! Deallocate tangent linear variable arrays 
     131      ! --------------------------------------- 
     132 
     133      IF ( kindic == 0 .OR. kindic == 1 ) THEN 
     134 
     135         IF ( ALLOCATED(etot3_tl) ) DEALLOCATE( etot3_tl ) 
     136 
     137      END IF 
     138 
     139      IF ( kindic == 0 .OR. kindic == 2 ) THEN 
     140             
     141         ! Deallocate adjoint variable arrays 
     142         ! -------------------------------- 
     143 
     144         IF ( ALLOCATED(etot3_ad) ) DEALLOCATE( etot3_ad ) 
     145 
     146      END IF 
     147 
     148   END SUBROUTINE trc_oce_tam_deallocate 
    106149#endif 
    107150END MODULE trc_oce_tam 
Note: See TracChangeset for help on using the changeset viewer.