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 1884 – NEMO

Changeset 1884


Ignore:
Timestamp:
2010-05-27T11:26:52+02:00 (14 years ago)
Author:
rblod
Message:

Light adaptation of NEMO direct model routine to handle TAM

Location:
branches/TAM_V3_0/NEMO/OPA_SRC
Files:
22 edited

Legend:

Unmodified
Added
Removed

  • branches/TAM_V3_0/NEMO/OPA_SRC/DTA/dtasal.F90

    r1152 r1884  
    3434   INTEGER ::   & 
    3535      numsdt,           &  !: logical unit for data salinity 
     36#if defined key_pomme_r025 
     37      nsal1, nsal2 ,     & ! first and second record used 
     38      nlecsa = 0           ! flag for first read 
     39#else 
    3640      nsal1, nsal2         ! first and second record used 
     41#endif 
    3742   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    3843      saldta    ! salinity data at two consecutive times 
    … …  
    8994     REAL(wp)  :: zfac 
    9095#endif 
     96      CHARACTER (len=38) ::   & 
     97         cl_sdata = 'data_1m_salinity_nomask ' 
    9198     REAL(wp), DIMENSION(jpk,2) ::   & 
    9299          zsaldta            ! auxiliary array for interpolation 
    … …  
    96103     ! ----------------- 
    97104      
    98      iman  = INT( raamo ) 
     105#if defined key_pomme_r025 
     106! DRAKKAR : we use input file with 1 month only 
     107      iman = 1 
     108#else 
     109      iman  = INT( raamo ) 
     110#endif 
     111 
    99112!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    100113     i15   = nday / 16 
    … …  
    109122        nsal1 = 0   ! initializations 
    110123        IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
    111         CALL iom_open ( 'data_1m_salinity_nomask', numsdt )  
    112          
     124        CALL iom_open ( cl_sdata, numsdt )  
     125 
    113126     ENDIF 
    114127      
    … …  
    117130     ! ------------------- 
    118131      
     132#if defined key_pomme_r025 
     133!    IF( kt == nit000 .OR. imois /= nsal1 ) THEN 
     134! In standard ORCA025, no damping is done. We read Levitus only for initial condition 
     135     IF( kt == nit000 .AND. nlecsa == 0 ) THEN 
     136        nlecsa =  1 
     137#else 
    119138     IF( kt == nit000 .OR. imois /= nsal1 ) THEN 
     139#endif 
    120140         
    121141        ! 2.1 Calendar computation 
    … …  
    318338           CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    319339        ENDIF 
     340#if ! defined key_pomme_r025 
    320341     ENDIF 
     342#endif 
    321343      
    322344      
    … …  
    326348     zxy = FLOAT(nday + 15 - 30*i15)/30. 
    327349     s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 
     350 
     351#if defined key_pomme_r025 
     352     ENDIF 
     353#endif 
    328354      
    329355     ! Close the file 

  • branches/TAM_V3_0/NEMO/OPA_SRC/DTA/dtatem.F90

    r1152 r1884  
    3333   INTEGER ::   & 
    3434      numtdt,        &  !: logical unit for data temperature 
     35#if defined key_pomme_r025 
     36      ntem1, ntem2 , &  ! first and second record used 
     37      nlecte = 0        ! switch for frist read 
     38#else 
    3539      ntem1, ntem2  ! first and second record used 
     40#endif 
    3641   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    3742      temdta            ! temperature data at two consecutive times 
    … …  
    9499      REAL(wp)  :: zfac 
    95100#endif 
     101      CHARACTER (len=38) ::   & 
     102         cl_tdata = 'data_1m_potential_temperature_nomask ' 
    96103      REAL(wp), DIMENSION(jpk,2) ::   & 
    97104         ztemdta            ! auxiliary array for interpolation 
    … …  
    101108      ! ----------------- 
    102109       
     110#if defined key_pomme_r025 
     111! DRAKKAR : we use input file with 1 month only 
     112      iman = 1 
     113#else 
    103114      iman  = INT( raamo ) 
     115#endif 
    104116!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    105117      i15   = nday / 16 
    … …  
    114126         ntem1= 0   ! initializations 
    115127         IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 
    116          CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt )  
     128         CALL iom_open ( cl_tdata, numtdt )  
    117129          
    118130      ENDIF 
    … …  
    122134      ! ------------------- 
    123135       
     136#if defined key_pomme_r025 
     137! DRAKKAR read only first step 
     138!     IF( kt == nit000 .OR. imois /= ntem1 ) THEN 
     139      IF( kt == nit000 .AND. nlecte == 0 ) THEN 
     140         nlecte = 1 
     141#else 
    124142      IF( kt == nit000 .OR. imois /= ntem1 ) THEN 
     143#endif 
    125144          
    126145         ! Calendar computation 
    … …  
    314333            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    315334         ENDIF 
     335#if ! defined key_pomme_r025 
    316336      ENDIF 
     337#endif 
    317338       
    318339       
    … …  
    322343      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    323344      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
    324        
     345 
     346#if defined key_pomme_r025 
     347      ENDIF 
     348#endif 
     349 
    325350      ! Close the file 
    326351      ! -------------- 

  • branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynadv.F90

    r1152 r1884  
    2323 
    2424   PUBLIC dyn_adv     ! routine called by step module 
     25   PUBLIC dyn_adv_ctl ! routine called by dyn_adv_tam module 
    2526  
    2627   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    ! vector form flag 

  • branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynspg.F90

    r1152 r1884  
    7070      CASE (  2 )   ;   CALL dyn_spg_flt    ( kt, kindic )      ! filtered 
    7171      CASE (  3 )   ;   CALL dyn_spg_rl     ( kt, kindic )      ! rigid lid 
    72       !                                                     
     72      ! 
    7373      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    74          ;              CALL dyn_spg_exp    ( kt ) 
    75          ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, & 
     74                        CALL dyn_spg_exp    ( kt ) 
     75                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, & 
    7676            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    77          ;              CALL dyn_spg_ts     ( kt ) 
    78          ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, & 
     77                        CALL dyn_spg_ts     ( kt ) 
     78                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, & 
    7979            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    80          ;              CALL dyn_spg_flt  ( kt, kindic ) 
    81          ;              CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 
     80                        CALL dyn_spg_flt  ( kt, kindic ) 
     81                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 
    8282            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8383      END SELECT 

  • branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r1200 r1884  
    252252#if defined key_obc 
    253253      CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
    254       CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
     254#  if defined key_pomme_r025 
     255      IF( nbit_cmp == 0 )  CALL obc_vol( kt )  ! Correction of the barotropic componant velocity to control the volume of the system 
     256#  else 
     257      CALL obc_vol( kt )  ! Correction of the barotropic componant velocity to control the volume of the system 
     258#  endif 
    255259#endif 
    256260#if defined key_bdy 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obc_oce.F90

    r1158 r1884  
    6060      !                       !  scale are set to 0 in the namelist, for both inflow and outflow). 
    6161 
     62#if defined key_pomme_r025 
     63   ! Logical for restarting with radiative OBCs, but without an OBC restart restart.obc.output file. 
     64   ! During the first 30 time steps, used FIXED boundary conditions. 
     65   ! We modify : obcini, obctra, obcdyn 
     66   LOGICAL :: ln_obc_rstart = .FALSE. !: radiative OBCs, but do not read restart.obc.output 
     67 
    6268   REAL(wp), PUBLIC ::    &  !: 
    63       obcsurftot       !: Total lateral surface of open boundaries 
     69!     Add computation of E/W/N/S lateral surface of open boundaries 
     70      obcsurftot      ,   &  !: Total lateral surface of open boundaries 
     71      obcsurfeast     ,   &  !: East  lateral surface of open boundaries 
     72      obcsurfwest     ,   &  !: West  lateral surface of open boundaries 
     73      obcsurfnorth    ,   &  !: North lateral surface of open boundaries 
     74      obcsurfsouth           !: South lateral surface of open boundaries 
     75#endif 
     76 
     77!   REAL(wp), PUBLIC ::    &  !: 
     78!      obcsurftot       !: Total lateral surface of open boundaries 
    6479    
    6580   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &  !: 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obc_par.F90

    r1152 r1884  
    3232   !!---------------------------------------------------------------------- 
    3333#    include "obc_par_EEL_R5.h90" 
     34  
     35# elif defined key_pomme_r025  
     36   !!----------------------------------------------------------------------  
     37   !!   'key_pomme_r025' :                         POMME R025 configuration  
     38   !!----------------------------------------------------------------------  
     39#    include "obc_par_POMME_R025.h90"  
    3440 
    3541# else 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcdta.F90

    r1156 r1884  
    6363  LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE.  ! checks 
    6464  LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 
     65 
     66  LOGICAL :: ln_obc_tangential=.FALSE. 
    6567 
    6668  !! * Substitutions 
    … …  
    829831          IF( imois == 0 )   imois = iman 
    830832          itimo = imois 
     833#if defined key_pomme_r025 
     834       ELSE IF ( ntobc == 14 )   THEN 
     835          i15   = nday / 16 
     836          imois = nmonth + i15 - 1 
     837          itimo = imois + 1 ! shift 
     838#endif 
    831839       ELSE 
    832840          IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 
    … …  
    11911199          CALL iom_close ( id_e ) 
    11921200          ! 
    1193           CALL iom_open ( cl_obc_eV , id_e ) 
    1194           CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 
    1195                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1196           CALL iom_close ( id_e ) 
     1201 
     1202          IF ( ln_obc_tangential ) THEN 
     1203             CALL iom_open ( cl_obc_eV , id_e ) 
     1204             CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 
     1205                  &              ktime=ntobc_x , kstart=istart, kcount= icount ) 
     1206             CALL iom_close ( id_e ) 
     1207          ENDIF 
    11971208 
    11981209          ! mask the boundary values 
    … …  
    12611272          CALL iom_close ( id_w ) 
    12621273          ! 
    1263           CALL iom_open ( cl_obc_wV , id_w ) 
    1264           CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 
    1265                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1266           CALL iom_close ( id_w ) 
     1274          IF ( ln_obc_tangential ) THEN 
     1275             CALL iom_open ( cl_obc_wV , id_w ) 
     1276             CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 
     1277                  &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
     1278             CALL iom_close ( id_w ) 
     1279          ENDIF 
    12671280 
    12681281          ! mask the boundary values 
    … …  
    13221335          CALL iom_close (id_n) 
    13231336          ! 
    1324           CALL iom_open ( cl_obc_nU , id_n ) 
    1325           CALL iom_get  ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 
    1326                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1327           CALL iom_close ( id_n ) 
     1337          IF ( ln_obc_tangential ) THEN 
     1338             CALL iom_open ( cl_obc_nU , id_n ) 
     1339             CALL iom_get  ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 
     1340                  &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
     1341             CALL iom_close ( id_n ) 
     1342          ENDIF 
    13281343          ! 
    13291344          CALL iom_open ( cl_obc_nV , id_n ) 
    … …  
    13871402          CALL iom_close (id_s) 
    13881403          ! 
    1389           CALL iom_open ( cl_obc_sU , id_s ) 
    1390           CALL iom_get  ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 
    1391                &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
    1392           CALL iom_close ( id_s ) 
     1404          IF ( ln_obc_tangential ) THEN 
     1405             CALL iom_open ( cl_obc_sU , id_s ) 
     1406             CALL iom_get  ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 
     1407                  &               ktime=ntobc_x , kstart=istart, kcount= icount ) 
     1408             CALL iom_close ( id_s ) 
     1409          ENDIF 
    13931410          ! 
    13941411          CALL iom_open ( cl_obc_sV , id_s ) 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcdyn.F90

    r1152 r1884  
    4747   REAL(wp) ::   rtaue  , rtauw  , rtaun  , rtaus  ,  & 
    4848                 rtauein, rtauwin, rtaunin, rtausin 
     49 
     50   LOGICAL  ::   ll_fbc 
    4951 
    5052   !!--------------------------------------------------------------------------------- 
    … …  
    102104      END IF 
    103105 
    104       IF( lp_obc_east  )   CALL obc_dyn_east ( kt ) 
    105       IF( lp_obc_west  )   CALL obc_dyn_west ( kt ) 
    106       IF( lp_obc_north )   CALL obc_dyn_north( kt ) 
    107       IF( lp_obc_south )   CALL obc_dyn_south( kt ) 
     106      ll_fbc = ( ( ( kt < nit000+3  ) .AND. .NOT.  ln_rstart     ) .OR. lk_dynspg_exp )  
     107 
     108      IF ( cp_cfg == "indian" ) THEN 
     109         ll_fbc = ( ( ( kt < nit000+30 ) .AND. .NOT.  ln_obc_rstart ) .OR. lk_dynspg_exp )  
     110      ENDIF 
     111 
     112      IF( lp_obc_east  )   CALL obc_dyn_east !( kt ) 
     113      IF( lp_obc_west  )   CALL obc_dyn_west !( kt ) 
     114      IF( lp_obc_north )   CALL obc_dyn_north!( kt ) 
     115      IF( lp_obc_south )   CALL obc_dyn_south!( kt ) 
    108116 
    109117      IF( lk_mpp ) THEN 
    … …  
    119127 
    120128 
    121    SUBROUTINE obc_dyn_east ( kt ) 
     129   SUBROUTINE obc_dyn_east 
    122130      !!------------------------------------------------------------------------------ 
    123131      !!                  ***  SUBROUTINE obc_dyn_east  *** 
    … …  
    137145      !!------------------------------------------------------------------------------ 
    138146      !! * Arguments 
    139       INTEGER, INTENT( in ) ::   kt 
    140147 
    141148      !! * Local declaration 
    … …  
    147154      ! -------------------------------------------------------- 
    148155 
    149       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp ) THEN 
     156      IF ( ll_fbc .OR. lfbceast ) THEN 
    150157 
    151158         ! 1.1 U zonal velocity     
    … …  
    282289 
    283290 
    284    SUBROUTINE obc_dyn_west ( kt ) 
     291   SUBROUTINE obc_dyn_west 
    285292      !!------------------------------------------------------------------------------ 
    286293      !!                  ***  SUBROUTINE obc_dyn_west  *** 
    … …  
    300307      !!------------------------------------------------------------------------------ 
    301308      !! * Arguments 
    302       INTEGER, INTENT( in ) ::   kt 
    303309 
    304310      !! * Local declaration 
    … …  
    310316      ! -------------------------------------------------------- 
    311317 
    312       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp ) THEN 
     318      IF ( ll_fbc .OR. lfbcwest ) THEN 
    313319 
    314320         ! 1.1 U zonal velocity 
    … …  
    443449   END SUBROUTINE obc_dyn_west 
    444450 
    445    SUBROUTINE obc_dyn_north ( kt ) 
     451   SUBROUTINE obc_dyn_north 
    446452      !!------------------------------------------------------------------------------ 
    447453      !!                     SUBROUTINE obc_dyn_north 
    … …  
    461467      !!------------------------------------------------------------------------------ 
    462468      !! * Arguments 
    463       INTEGER, INTENT( in ) ::   kt 
    464469 
    465470      !! * Local declaration 
    … …  
    471476      ! --------------------------------------------------------- 
    472477  
    473       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth  .OR. lk_dynspg_exp ) THEN 
    474  
     478        IF ( ll_fbc .OR. lfbcnorth ) THEN 
     479     
    475480         ! 1.1 U zonal velocity 
    476481         ! -------------------- 
    … …  
    611616         END DO 
    612617# endif 
     618 
     619 
    613620      END IF 
    614621 
    615622   END SUBROUTINE obc_dyn_north 
    616623 
    617    SUBROUTINE obc_dyn_south ( kt ) 
     624   SUBROUTINE obc_dyn_south 
    618625      !!------------------------------------------------------------------------------ 
    619626      !!                     SUBROUTINE obc_dyn_south 
    … …  
    633640      !!------------------------------------------------------------------------------ 
    634641      !! * Arguments 
    635       INTEGER, INTENT( in ) ::   kt 
    636642 
    637643      !! * Local declaration 
    … …  
    646652      ! --------------------------------------------------------- 
    647653 
    648       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth  .OR. lk_dynspg_exp ) THEN 
    649  
     654      IF ( ll_fbc .OR. lfbcsouth ) THEN 
     655       
    650656         ! 1.1 U zonal velocity 
    651657         ! -------------------- 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcini.F90

    r1152 r1884  
    1919   USE in_out_manager  ! I/O units 
    2020   USE dynspg_oce      ! flag lk_dynspg_flt 
     21#if defined key_pomme_r025 
     22   USE iom 
     23#endif 
    2124 
    2225   IMPLICIT NONE 
    … …  
    6467      !! * Local declarations 
    6568      INTEGER  ::   ji, jj, istop , inumfbc 
     69#if defined key_pomme_r025 
     70      INTEGER inum0 
     71#endif 
    6672      INTEGER, DIMENSION(4) ::   icorner 
    6773      REAL(wp) ::   zbsic1, zbsic2, zbsic3 
    … …  
    111117      IF(lwp) WRITE(numout,*) '         Number of open boundaries    nbobc = ',nbobc 
    112118      IF(lwp) WRITE(numout,*) 
    113       IF( nbobc /= 0 .AND. jperio /= 0 ) & 
     119      IF( nbobc >=  2 .AND. jperio /= 0 ) & 
    114120           &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    115121 
    … …  
    433439      ENDIF 
    434440 
     441#if defined key_pomme_r025 
     442       
     443      IF ( nmsh == 1 ) THEN 
     444         WRITE(numout,*) 'obc_init : appending obc masks in mesh_mask.nc' 
     445         CALL iom_open( 'mesh_mask_obc.nc', inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
     446         CALL iom_rstput( 0, 0, inum0, 'obctmsk', obctmsk ) 
     447         CALL iom_rstput( 0, 0, inum0, 'obcumask', obcumask ) 
     448         CALL iom_rstput( 0, 0, inum0, 'obcvmask', obcvmask ) 
     449         CALL iom_close(inum0) 
     450      ENDIF 
     451#endif 
     452 
    435453      IF (lk_dynspg_rl ) THEN  
    436454        ! do nothing particular 
    … …  
    441459           ! 3.1 Total lateral surface  
    442460           ! ------------------------- 
    443            obcsurftot = 0.e0 
     461 
     462 
     463           MPI_CHK : IF ( nbit_cmp == 1 ) THEN 
     464 
     465              IF(         ( lp_obc_west  .AND. lp_obc_west_barotp_corr )  & 
     466                   & .OR. ( lp_obc_east  .AND. lp_obc_east_barotp_corr )  & 
     467                   & .OR. ( lp_obc_north .AND. lp_obc_north_barotp_corr ) & 
     468                   & .OR. ( lp_obc_south .AND. lp_obc_south_barotp_corr )   ) THEN 
     469                 IF(lwp)WRITE(numout,cform_war) 
     470                 IF(lwp)WRITE(numout,*) '           nbit_cmp = 1 => no barotropic redistribution along OBCs is enforced' 
     471                 nwarn = nwarn + 1 
     472              ENDIF 
     473               
     474           ELSE 
     475               
     476              obcsurfeast  = 0.e0       ;       obcsurfwest  = 0.e0 
     477              obcsurfnorth = 0.e0       ;       obcsurfsouth = 0.e0 
     478              obcsurftot = 0.e0 
    444479   
    445            IF( lp_obc_east ) THEN ! ... East open boundary lateral surface 
    446               DO ji = nie0, nie1 
    447                  DO jj = 1, jpj  
    448                     obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
     480              IF( lp_obc_east .AND. lp_obc_east_barotp_corr ) THEN ! ... East open boundary lateral surface 
     481                 DO ji = nie0, nie1 
     482                    DO jj = 1, jpj  
     483                       obcsurfeast = obcsurfeast+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
     484                    END DO 
    449485                 END DO 
    450               END DO 
    451            END IF 
    452    
    453            IF( lp_obc_west ) THEN ! ... West open boundary lateral surface 
    454               DO ji = niw0, niw1 
    455                  DO jj = 1, jpj  
    456                     obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
     486                 obcsurftot = obcsurftot + obcsurfeast 
     487              END IF 
     488               
     489              IF( lp_obc_west .AND. lp_obc_west_barotp_corr ) THEN ! ... West open boundary lateral surface 
     490                 DO ji = niw0, niw1 
     491                    DO jj = 1, jpj  
     492                       obcsurfwest = obcsurfwest+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 
     493                    END DO 
    457494                 END DO 
    458               END DO 
    459            END IF 
    460    
    461            IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 
    462               DO jj = njn0, njn1 
    463                  DO ji = 1, jpi 
    464                     obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
     495                 obcsurftot = obcsurftot + obcsurfwest 
     496              END IF 
     497               
     498              IF( lp_obc_north .AND. lp_obc_north_barotp_corr ) THEN  ! ... North open boundary lateral surface 
     499                 DO jj = njn0, njn1 
     500                    DO ji = 1, jpi 
     501                       obcsurfnorth = obcsurfnorth+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
     502                    END DO 
    465503                 END DO 
    466               END DO 
    467            END IF 
    468    
    469            IF( lp_obc_south ) THEN ! ... South open boundary lateral surface 
    470               DO jj = njs0, njs1 
    471                  DO ji = 1, jpi 
    472                     obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
     504                 obcsurftot = obcsurftot + obcsurfnorth 
     505              END IF 
     506               
     507              IF( lp_obc_south .AND. lp_obc_south_barotp_corr ) THEN ! ... South open boundary lateral surface 
     508                 DO jj = njs0, njs1 
     509                    DO ji = 1, jpi 
     510                       obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 
     511                    END DO 
    473512                 END DO 
    474               END DO 
    475            END IF 
    476    
    477            IF( lk_mpp )   CALL mpp_sum( obcsurftot )   ! sum over the global domain 
     513                 obcsurftot = obcsurftot + obcsurfsouth 
     514              END IF 
     515               
     516              IF( lk_mpp )   CALL mpp_sum( obcsurftot )   ! sum over the global domain 
     517 
     518           ENDIF MPI_CHK 
     519 
    478520        ENDIF 
    479       ENDIF  ! rigid lid 
     521 
     522     ENDIF  ! rigid lid 
    480523 
    481524      ! 5. Control print on mask  
    … …  
    603646      ! -------------------------------------------------------------- 
    604647      !   only if at least one boundary is  radiative  
    605       IF ( inumfbc < nbobc .AND.  ln_rstart ) THEN 
    606          !  Restart from restart.obc 
    607          CALL obc_rst_read 
    608       ELSE 
     648 
     649       !  Restart from restart.obc 
     650 
     651!--> IND025 Begin 
     652       IF(lwp) WRITE(numout,*) 
     653       IF(lwp) WRITE(numout,*) ' obcini : ' 
     654       IF(lwp) WRITE(numout,*) '   ln_rstart     : ', ln_rstart 
     655       IF(lwp) WRITE(numout,*) '   ln_obc_rstart : ', ln_obc_rstart 
     656        
     657       IF ( .NOT. ln_rstart .AND. ln_obc_rstart ) THEN 
     658          IF(lwp) WRITE(numout,*) ' obcini : Warning!! ln_rstart = .F. => we force ln_obc_rstart =.F. ' 
     659          ln_obc_rstart = .FALSE. 
     660       ENDIF  
     661 
     662       IF ( ln_rstart .AND. ln_obc_rstart ) THEN 
     663          IF  ( inumfbc < nbobc ) THEN 
     664             IF(lwp) WRITE(numout,*) '   => We read the OBC restart file ' 
     665             CALL obc_rst_read 
     666          ELSE 
     667             IF(lwp) WRITE(numout,*) '   => We DO NOT read the OBC restart file (since all OBCs are fixed) ' 
     668          ENDIF 
     669           
     670!<-- IND025 End        
     671 
     672       ELSE 
    609673 
    610674!         ! ... Initialization to zero of radiation arrays. 

  • branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obctra.F90

    r1152 r1884  
    4343      rtauein, rtauwin, rtaunin, rtausin      ! Boundary restoring coefficient for inflow  
    4444 
     45   LOGICAL  ::   ll_fbc 
     46    
    4547   !! * Substitutions 
    4648#  include "obc_vectopt_loop_substitute.h90" 
    … …  
    9193      END IF 
    9294 
    93       IF( lp_obc_east  )   CALL obc_tra_east ( kt )    ! East open boundary 
    94  
    95       IF( lp_obc_west  )   CALL obc_tra_west ( kt )    ! West open boundary 
    96  
    97       IF( lp_obc_north )   CALL obc_tra_north( kt )    ! North open boundary 
    98  
    99       IF( lp_obc_south )   CALL obc_tra_south( kt )    ! South open boundary 
     95      ll_fbc = ( ( kt < nit000+3 ) .AND. .NOT. ln_rstart ) 
     96       
     97      IF ( cp_cfg == "indian" ) THEN 
     98         ll_fbc = ( ( kt < nit000+30 ) .AND. .NOT. ln_obc_rstart ) 
     99      ENDIF 
     100 
     101      IF( lp_obc_east  )   CALL obc_tra_east     ! East open boundary 
     102 
     103      IF( lp_obc_west  )   CALL obc_tra_west     ! West open boundary 
     104 
     105      IF( lp_obc_north )   CALL obc_tra_north    ! North open boundary 
     106 
     107      IF( lp_obc_south )   CALL obc_tra_south    ! South open boundary 
     108 
    100109 
    101110      IF( lk_mpp ) THEN                  !!bug ??? 
    … …  
    111120 
    112121 
    113    SUBROUTINE obc_tra_east ( kt ) 
     122   SUBROUTINE obc_tra_east 
    114123      !!------------------------------------------------------------------------------ 
    115124      !!                ***  SUBROUTINE obc_tra_east  *** 
    … …  
    128137      !!------------------------------------------------------------------------------ 
    129138      !! * Arguments 
    130       INTEGER, INTENT( in ) ::   kt 
    131139 
    132140      !! * Local declaration 
    … …  
    139147      ! -------------------------------------------------------- 
    140148 
    141       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN 
    142          DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 
     149      IF ( ll_fbc .OR. lfbceast ) THEN 
     150 
     151        DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 
    143152            DO jk = 1, jpkm1 
    144153               DO jj = 1, jpj 
    … …  
    211220 
    212221 
    213    SUBROUTINE obc_tra_west ( kt ) 
     222   SUBROUTINE obc_tra_west 
    214223      !!------------------------------------------------------------------------------ 
    215224      !!                 ***  SUBROUTINE obc_tra_west  *** 
    … …  
    228237      !!------------------------------------------------------------------------------ 
    229238      !! * Arguments 
    230       INTEGER, INTENT( in ) ::   kt 
    231239 
    232240      !! * Local declaration 
    … …  
    239247      ! -------------------------------------------------------- 
    240248 
    241       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN 
     249      IF ( ll_fbc .OR. lfbcwest ) THEN 
    242250 
    243251         DO ji = fs_niw0, fs_niw1 ! Vector opt. 
    … …  
    310318 
    311319 
    312    SUBROUTINE obc_tra_north ( kt ) 
     320   SUBROUTINE obc_tra_north 
    313321      !!------------------------------------------------------------------------------ 
    314322      !!                 ***  SUBROUTINE obc_tra_north  *** 
    … …  
    327335      !!------------------------------------------------------------------------------ 
    328336      !! * Arguments 
    329       INTEGER, INTENT( in ) ::   kt 
    330337 
    331338      !! * Local declaration 
    … …  
    338345      ! -------------------------------------------------------- 
    339346 
    340       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN 
     347      IF ( ll_fbc .OR. lfbcnorth ) THEN 
    341348 
    342349         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt. 
    … …  
    412419 
    413420 
    414    SUBROUTINE obc_tra_south ( kt ) 
     421   SUBROUTINE obc_tra_south 
    415422      !!------------------------------------------------------------------------------ 
    416423      !!                ***  SUBROUTINE obc_tra_south  *** 
    … …  
    429436      !!------------------------------------------------------------------------------ 
    430437      !! * Arguments 
    431       INTEGER, INTENT( in ) ::   kt 
    432438 
    433439      !! * Local declaration 
    … …  
    440446      ! -------------------------------------------------------- 
    441447 
    442       IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN 
     448      IF ( ll_fbc .OR. lfbcsouth ) THEN 
    443449 
    444450         DO jj = fs_njs0, fs_njs1  ! Vector opt. 

  • branches/TAM_V3_0/NEMO/OPA_SRC/TRA/tradmp.F90

    r1152 r1884  
    4141 
    4242   PUBLIC tra_dmp      ! routine called by step.F90 
     43   PUBLIC cofdis, dtacof, dtacof_zoom 
    4344 
    4445#if ! defined key_agrif 

  • branches/TAM_V3_0/NEMO/OPA_SRC/TRA/traqsr.F90

    r1146 r1884  
    3838   LOGICAL , PUBLIC ::   ln_qsr_sms = .false. ! flag to use or not the biological fluxes for light  
    3939    
    40    INTEGER ::   nksr   ! number of levels 
    41    REAL(wp), DIMENSION(jpk) ::   gdsr   ! profile of the solar flux penetration 
     40   INTEGER , PUBLIC ::   nksr   ! number of levels 
     41   REAL(wp), DIMENSION(jpk) , PUBLIC ::   gdsr   ! profile of the solar flux penetration 
    4242 
    4343   !! * Substitutions 

  • branches/TAM_V3_0/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r1156 r1884  
    169169         DO jj = 2, jpjm1 
    170170            DO ji = fs_2, fs_jpim1   ! vector opt. 
     171#if defined key_vvl 
    171172               zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 
     173#else 
     174               zvsfvvl = fsve3t(ji,jj,jk) 
     175#endif 
    172176               ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                ! after scale factor at T-point 
    173177               ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl                        ! now   scale factor at T-point 
    … …  
    182186      DO jj = 2, jpjm1 
    183187         DO ji = fs_2, fs_jpim1   ! vector opt. 
     188#if defined key_vvl 
    184189            zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 
     190#else 
     191            zvsfvvl = fsve3t(ji,jj,1) 
     192#endif 
    185193            ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                   ! after scale factor at T-point 
    186194            zwi(ji,jj,1) = 0.e0 
    … …  
    227235      DO jj = 2, jpjm1 
    228236         DO ji = fs_2, fs_jpim1 
     237#if defined key_vvl 
    229238            zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 
     239#else 
     240            zvsfvvl = fsve3t(ji,jj,1) 
     241#endif 
    230242            ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 
    231243            ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,1) 
    … …  
    236248         DO jj = 2, jpjm1 
    237249            DO ji = fs_2, fs_jpim1 
     250#if defined key_vvl 
    238251               zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 
     252#else 
     253               zvsfvvl = fsve3t(ji,jj,jk) 
     254#endif 
    239255               ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 
    240256               ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,jk) 
    … …  
    271287         DO jj = 2, jpjm1 
    272288            DO ji = fs_2, fs_jpim1   ! vector opt. 
     289#if defined key_vvl 
    273290               zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 
     291#else 
     292               zvsfvvl = fsve3t(ji,jj,jk) 
     293#endif 
    274294               ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                      ! after scale factor at T-point 
    275295               ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl                              ! now   scale factor at T-point 
    … …  
    284304      DO jj = 2, jpjm1 
    285305         DO ji = fs_2, fs_jpim1   ! vector opt. 
     306#if defined key_vvl 
    286307            zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 
     308#else 
     309            zvsfvvl = fsve3t(ji,jj,1) 
     310#endif 
    287311            ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl                                          ! after scale factor at T-point 
    288312            zwi(ji,jj,1) = 0.e0 
    … …  
    328352      DO jj = 2, jpjm1 
    329353         DO ji = fs_2, fs_jpim1 
     354#if defined key_vvl 
    330355            zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 
     356#else 
     357            zvsfvvl = fsve3t(ji,jj,1)  
     358#endif 
    331359            ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl                               ! before scale factor at T-point 
    332360            ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,1)                        ! now    scale factor at T-point 
    … …  
    337365         DO jj = 2, jpjm1 
    338366            DO ji = fs_2, fs_jpim1 
     367#if defined key_vvl 
    339368               zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 
     369#else 
     370               zvsfvvl = fsve3t(ji,jj,jk)  
     371#endif 
    340372               ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl                            ! before scale factor at T-point 
    341373               ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,jk)                    ! now    scale factor at T-point 

  • branches/TAM_V3_0/NEMO/OPA_SRC/ZDF/zdftke.F90

    r1201 r1884  
    4949 
    5050   PUBLIC   zdf_tke    ! routine called in step module 
     51   PUBLIC   tke_rst 
    5152 
    5253   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 

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

    r1192 r1884  
    3838   PUBLIC day        ! called by step.F90 
    3939   PUBLIC day_init   ! called by istate.F90 
     40   PUBLIC day_mth    ! called by daymod_tam.F90 
    4041 
    4142   INTEGER , PUBLIC ::   nyear       !: current year 

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

    r1146 r1884  
    5555   REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
    5656   REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     57 
     58   INTEGER, PUBLIC  ::   neos_init = 0     !: control flag for initialization 
    5759    
    58    INTEGER ::   neos_init = 0         !: control flag for initialization 
    59  
    6060   !! * Substitutions 
    6161#  include "domzgr_substitute.h90" 

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

    r1152 r1884  
    33   !!                     ***  MODULE  geo2ocean  *** 
    44   !! Ocean mesh    :  ??? 
    5    !!===================================================================== 
     5   !!====================================================================== 
     6   !! History :  OPA  !  07-1996  (O. Marti)  Original code 
     7   !!   NEMO     1.0  !  02-2008  (G. Madec)  F90: Free form 
     8   !!            3.0  !   
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    … …  
    1115   !!   repere      :   old routine suppress it ??? 
    1216   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1417   USE dom_oce         ! mesh and scale factors 
    1518   USE phycst          ! physical constants 
    … …  
    1821 
    1922   IMPLICIT NONE 
    20  
    21    !! * Accessibility 
    2223   PRIVATE 
    23    PUBLIC rot_rep, repcmo, repere, geo2oce   ! only rot_rep should be used 
     24 
     25   PUBLIC   rot_rep, repcmo, repere, geo2oce, oce2geo   ! only rot_rep should be used 
    2426                                             ! repcmo and repere are keep only for compatibility. 
    2527                                             ! they are only a useless overlay of rot_rep 
    26  
    27    !! * Module variables 
     28   PUBLIC   obs_rot 
     29 
    2830   REAL(wp), DIMENSION(jpi,jpj) ::   & 
    2931      gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point 
    … …  
    3436   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above) 
    3537 
    36   !! * Substitutions 
     38   !! * Substitutions 
    3739#  include "vectopt_loop_substitute.h90" 
    38    !!--------------------------------------------------------------------------------- 
    39    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    40    !! $Id$ 
    41    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    42    !!--------------------------------------------------------------------------------- 
     40   !!---------------------------------------------------------------------- 
     41   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)  
     42   !! $Id$  
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !!---------------------------------------------------------------------- 
    4345 
    4446CONTAINS 
    … …  
    5456      !! ** Method  :   Initialization of arrays at the first call. 
    5557      !! 
    56       !! ** Action  : - px2 : first componante (defined at u point) 
     58      !! ** Action  : - px2 : first  componante (defined at u point) 
    5759      !!              - py2 : second componante (defined at v point) 
    58       !! 
    59       !! History : 
    60       !!   7.0  !  07-96  (O. Marti)  Original code 
    61       !!   8.5  !  02-08  (G. Madec)  F90: Free form 
    62       !!---------------------------------------------------------------------- 
    63       !! * Arguments  
    64       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &  
    65          pxu1, pyu1,     & ! geographic vector componantes at u-point 
    66          pxv1, pyv1        ! geographic vector componantes at v-point 
    67       REAL(wp), INTENT( out ), DIMENSION(jpi,jpj) ::   &  
    68          px2,            & ! i-componante (defined at u-point) 
    69          py2               ! j-componante (defined at v-point) 
     60      !!---------------------------------------------------------------------- 
     61      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxu1, pyu1   ! geographic vector componantes at u-point 
     62      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxv1, pyv1   ! geographic vector componantes at v-point 
     63      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point) 
     64      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
    7065      !!---------------------------------------------------------------------- 
    7166       
    7267      ! Change from geographic to stretched coordinate 
    7368      ! ---------------------------------------------- 
    74        
    7569      CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
    7670      CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
    … …  
    9084      !!                  (O. Marti ) Original code (repere and repcmo) 
    9185      !!---------------------------------------------------------------------- 
    92       !! * Arguments  
    9386      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) ::   pxin, pyin   ! vector componantes 
    9487      CHARACTER(len=1),             INTENT( IN ) ::   cd_type      ! define the nature of pt2d array grid-points 
    … …  
    172165      !!   9.2  !  07-04  (S. Masson)  Add T, F points and bugfix in cos lateral boundary 
    173166      !!---------------------------------------------------------------------- 
    174       !! * local declarations 
    175167      INTEGER ::   ji, jj      ! dummy loop indices 
    176  
     168      !! 
    177169      REAL(wp) ::   & 
    178170         zlam, zphi,            &  ! temporary scalars 
    … …  
    320312 
    321313      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    322       CALL lbc_lnk ( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
    323       CALL lbc_lnk ( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
    324       CALL lbc_lnk ( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
    325       CALL lbc_lnk ( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
     314      CALL lbc_lnk( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
     315      CALL lbc_lnk( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
     316      CALL lbc_lnk( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
     317      CALL lbc_lnk( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
    326318 
    327319   END SUBROUTINE angle 
    328320 
    329321 
    330    SUBROUTINE geo2oce ( pxx , pyy , pzz, cgrid,     & 
    331                         plon, plat, pte, ptn  , ptv ) 
     322   SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid,     & 
     323                        pte, ptn ) 
    332324      !!---------------------------------------------------------------------- 
    333325      !!                    ***  ROUTINE geo2oce  *** 
    … …  
    344336      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb 
    345337      !!   8.5  !  02-06  (G. Madec)  F90: Free form 
    346       !!---------------------------------------------------------------------- 
    347       !! * Local declarations 
    348       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
    349          pxx, pyy, pzz 
    350       CHARACTER (len=1), INTENT( in) ::   & 
    351          cgrid 
    352       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
    353          plon, plat 
    354       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::    & 
    355          pte, ptn, ptv 
     338      !!   3.0  !  07-08  (G. Madec)  geo2oce suppress lon/lat agruments 
     339      !!---------------------------------------------------------------------- 
     340      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::  pxx, pyy, pzz 
     341      CHARACTER(len=1)            , INTENT(in   ) ::  cgrid 
     342      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::  pte, ptn 
     343      !! 
    356344      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
    357345      REAL(wp), PARAMETER :: rad = rpi / 180.e0 
    358  
    359       !! * Local variables 
    360346      INTEGER ::   ig     ! 
    361  
    362347      !! * Local save 
    363       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   & 
    364          zsinlon, zcoslon,   & 
    365          zsinlat, zcoslat 
    366       LOGICAL, SAVE, DIMENSION (4) ::   & 
    367          linit = .FALSE. 
     348      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
     349      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    368350      !!---------------------------------------------------------------------- 
    369351 
    370352      SELECT CASE( cgrid) 
    371  
    372          CASE ( 't' ) ;; ig = 1 
    373          CASE ( 'u' ) ;; ig = 2 
    374          CASE ( 'v' ) ;; ig = 3 
    375          CASE ( 'f' ) ;; ig = 4 
    376  
    377          CASE default 
     353         CASE ( 'T' )    
     354            ig = 1 
     355            IF( .NOT. linit(ig) ) THEN  
     356               zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
     357               zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
     358               zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
     359               zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     360               linit(ig) = .TRUE. 
     361            ENDIF 
     362         CASE ( 'U' )    
     363            ig = 2 
     364            IF( .NOT. linit(ig) ) THEN  
     365               zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
     366               zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
     367               zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     368               zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     369               linit(ig) = .TRUE. 
     370            ENDIF 
     371         CASE ( 'V' )    
     372            ig = 3 
     373            IF( .NOT. linit(ig) ) THEN  
     374               zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
     375               zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
     376               zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     377               zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     378               linit(ig) = .TRUE. 
     379            ENDIF 
     380         CASE ( 'F' )    
     381            ig = 4 
     382            IF( .NOT. linit(ig) ) THEN  
     383               zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
     384               zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
     385               zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
     386               zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     387               linit(ig) = .TRUE. 
     388            ENDIF 
     389         CASE default    
    378390            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 
    379391            CALL ctl_stop( ctmp1 ) 
    380        END SELECT 
    381        
    382       IF( .NOT. linit(ig) ) THEN  
    383          zsinlon (:,:,ig) = SIN (rad * plon) 
    384          zcoslon (:,:,ig) = COS (rad * plon) 
    385          zsinlat (:,:,ig) = SIN (rad * plat) 
    386          zcoslat (:,:,ig) = COS (rad * plat) 
    387          linit (ig) = .TRUE. 
    388       ENDIF 
    389        
    390       pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy 
    391       ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx    & 
    392             - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    & 
    393             + zcoslat (:,:,ig) * pzz 
    394       ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    & 
    395             + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    & 
    396             + zsinlat (:,:,ig) * pzz 
    397  
     392      END SELECT 
     393       
     394      pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 
     395      ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx    & 
     396            - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy    & 
     397            + zcoslat(:,:,ig) * pzz 
     398!!$   ptv =   zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx    & 
     399!!$         + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy    & 
     400!!$         + zsinlat(:,:,ig) * pzz 
     401      ! 
    398402   END SUBROUTINE geo2oce 
     403 
     404   SUBROUTINE oce2geo ( pte, ptn, cgrid,     & 
     405                        pxx , pyy , pzz ) 
     406      !!---------------------------------------------------------------------- 
     407      !!                    ***  ROUTINE oce2geo  *** 
     408      !!       
     409      !! ** Purpose : 
     410      !! 
     411      !! ** Method  :   Change vector from east/north to geocentric 
     412      !! 
     413      !! History : 
     414      !!        !         (A. Caubel)  oce2geo - Original code 
     415      !!---------------------------------------------------------------------- 
     416      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn 
     417      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid 
     418      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz 
     419      !! 
     420      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
     421      REAL(wp), PARAMETER :: rad = rpi / 180.e0 
     422      INTEGER ::   ig     ! 
     423      !! * Local save 
     424      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
     425      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
     426      !!---------------------------------------------------------------------- 
     427 
     428      SELECT CASE( cgrid) 
     429         CASE ( 'T' )    
     430            ig = 1 
     431            IF( .NOT. linit(ig) ) THEN  
     432               zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
     433               zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
     434               zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
     435               zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     436               linit(ig) = .TRUE. 
     437            ENDIF 
     438         CASE ( 'U' )    
     439            ig = 2 
     440            IF( .NOT. linit(ig) ) THEN  
     441               zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
     442               zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
     443               zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     444               zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     445               linit(ig) = .TRUE. 
     446            ENDIF 
     447         CASE ( 'V' )    
     448            ig = 3 
     449            IF( .NOT. linit(ig) ) THEN  
     450               zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
     451               zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
     452               zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     453               zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     454               linit(ig) = .TRUE. 
     455            ENDIF 
     456         CASE ( 'F' )    
     457            ig = 4 
     458            IF( .NOT. linit(ig) ) THEN  
     459               zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
     460               zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
     461               zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
     462               zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     463               linit(ig) = .TRUE. 
     464            ENDIF 
     465         CASE default    
     466            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 
     467            CALL ctl_stop( ctmp1 ) 
     468      END SELECT 
     469 
     470       pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn  
     471       pyy =   zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 
     472       pzz =   zcoslat(:,:,ig) * ptn 
     473 
     474       
     475   END SUBROUTINE oce2geo 
    399476 
    400477 
    … …  
    446523   END SUBROUTINE repere 
    447524 
     525   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv ) 
     526      !!---------------------------------------------------------------------- 
     527      !!                  ***  ROUTINE obs_rot  *** 
     528      !! 
     529      !! ** Purpose :   Copy gsinu, gcosu, gsinv and gsinv  
     530      !!                to input data for rotations of 
     531      !!                current at observation points 
     532      !! 
     533      !! History : 
     534      !!   9.2  !  09-02  (K. Mogensen) 
     535      !!---------------------------------------------------------------------- 
     536      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   & 
     537         & psinu, pcosu, psinv, pcosv! copy of data 
     538 
     539      !!---------------------------------------------------------------------- 
     540 
     541      ! Initialization of gsin* and gcos* at first call 
     542      ! ----------------------------------------------- 
     543 
     544      IF( lmust_init ) THEN 
     545         IF(lwp) WRITE(numout,*) 
     546         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 
     547         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation' 
     548 
     549         CALL angle       ! initialization of the transformation 
     550         lmust_init = .FALSE. 
     551 
     552      ENDIF 
     553       
     554      psinu(:,:) = gsinu(:,:) 
     555      pcosu(:,:) = gcosu(:,:) 
     556      psinv(:,:) = gsinv(:,:) 
     557      pcosv(:,:) = gcosv(:,:) 
     558       
     559   END SUBROUTINE obs_rot 
     560 
     561 
    448562  !!====================================================================== 
    449563END MODULE geo2ocean 

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

    r1209 r1884  
    110110   INTEGER ::   & 
    111111      mppsize,  &  ! number of process 
    112       mpprank,  &  ! process number  [ 0 - size-1 ] 
     112      mpprank      ! process number  [ 0 - size-1 ] 
     113 
     114   INTEGER, PUBLIC ::   &       
    113115      mpi_comm_opa ! opa local communicator 
    114116 
    … …  
    122124      nrank_ice            ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 
    123125   ! variables used in case of north fold condition in mpp_mpi with jpni > 1 
    124    INTEGER ::      &       ! 
     126   INTEGER, PUBLIC ::   &    ! 
    125127      ngrp_world,  &       ! group ID for the world processors 
    126128      ngrp_north,  &       ! group ID for the northern processors (to be fold) 
    … …  
    128130      ndim_rank_north, &   ! number of 'sea' processor in the northern line (can be /= jpni !) 
    129131      njmppmax             ! value of njmpp for the processors of the northern line 
    130    INTEGER ::      &       ! 
     132   INTEGER, PUBLIC ::      &       ! 
    131133      north_root           ! number (in the comm_opa) of proc 0 in the northern comm 
    132    INTEGER, DIMENSION(:), ALLOCATABLE ::   & 
     134   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE ::   & 
    133135      nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 
    134136   CHARACTER (len=1) ::  & 
    135137      c_mpi_send = 'S'     ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    136    LOGICAL  ::           & 
     138   LOGICAL, PUBLIC  ::           & 
    137139      l_isend = .FALSE.    ! isend use indicator (T if c_mpi_send='I') 
    138140   INTEGER ::            & ! size of the buffer in case of mpi_bsend  

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

    r1146 r1884  
    6767   USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    6868 
     69   USE tamtrj          ! writing out state trajectory  
     70 
    6971   USE step            ! OPA time-stepping                  (stp     routine) 
    7072#if defined key_oasis3 
    … …  
    302304      CALL dia_ptr_init                     ! Poleward TRansports initialization 
    303305 
     306      CALL tam_trj_ini 
     307      IF(lwp) WRITE(numout,*)'Euler time step switch is ', neuler 
    304308      !                                     ! =============== ! 
    305309      !                                     !  time stepping  ! 

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

    r1152 r1884  
    3838      !                                !  ( <= jpni x jpnj ) 
    3939#endif 
    40  
     40  
    4141   INTEGER, PUBLIC, PARAMETER ::    &  !: 
    4242      jpr2di = 0,                   &  !: number of columns for extra outer halo  
    … …  
    5858#elif defined key_orca_r2 
    5959   !!--------------------------------------------------------------------- 
    60    !!   'key_orca_r2'   :                           global ocean : ORCA R4 
     60   !!   'key_orca_r2'   :                           global ocean : ORCA R2 
    6161   !!--------------------------------------------------------------------- 
    6262#             include "par_ORCA_R2.h90" 
    … …  
    9191   !!--------------------------------------------------------------------- 
    9292#             include "par_GYRE.h90" 
     93#elif defined key_pomme_r025  
     94   !!---------------------------------------------------------------------  
     95   !!   'key_pomme_r025':                        regional basin : POMME025  
     96   !!---------------------------------------------------------------------  
     97#             include "par_POMME_R025.h90"  
    9398#else 
    9499   !!--------------------------------------------------------------------- 

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

    r1151 r1884  
    111111   USE floats          ! floats computation               (flo_stp routine) 
    112112 
     113   USE tamtrj          ! writing out state trajectory     
     114 
    113115   USE stpctl          ! time stepping control            (stp_ctl routine) 
    114116   USE restart         ! ocean restart                    (rst_wri routine) 
    … …  
    163165      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index 
    164166#endif       
     167      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zta_tmp, zsa_tmp 
    165168      INTEGER ::   jk       ! dummy loop indice 
    166169      INTEGER ::   indic    ! error indicator if < 0 
    … …  
    262265                             ta(:,:,:) = 0.e0               ! set tracer trends to zero 
    263266                             sa(:,:,:) = 0.e0 
     267 
     268      ! Saving non-linear trajectory at restart state 
     269      ! May not be exact for sbc and zdf parameters 
     270      IF( ( ln_trjwri ) .AND. ( kstp == nit000 ) ) CALL tam_trj_wri( kstp - 1 ) 
    264271 
    265272                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    … …  
    293300 
    294301      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     302      ! saving ta and sa (temporary fix, please do not remove) 
     303      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     304      IF (ln_trjwri) THEN 
     305                               ALLOCATE ( zta_tmp(jpi,jpj,jpk), & 
     306            &                             zsa_tmp(jpi,jpj,jpk)  ) 
     307                               zta_tmp(:,:,:) = ta(:,:,:) 
     308                               zsa_tmp(:,:,:) = sa(:,:,:) 
     309      END IF 
     310 
     311      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    295312      ! Dynamics 
    296313      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    353370         IF( lk_diafwb  )   CALL dia_fwb( kstp )                 ! Fresh water budget diagnostics 
    354371         IF( ln_diaptr  )   CALL dia_ptr( kstp )                 ! Poleward TRansports diagnostics 
    355          !                                                 ! outputs 
    356                             CALL dia_wri( kstp, indic )          ! ocean model: outputs 
     372 
     373         !                                                 ! Outputs 
     374  
     375 
     376      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     377      ! restoring ta and sa (temporary fix, please do not remove) 
     378      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     379         IF (ln_trjwri) THEN 
     380            ta(:,:,:) = zta_tmp(:,:,:) 
     381            sa(:,:,:) = zsa_tmp(:,:,:) 
     382            DEALLOCATE ( zta_tmp, & 
     383               &         zsa_tmp  ) 
     384         END IF 
     385 
     386         !                                                 ! Outputs 
     387                            CALL dia_wri    ( kstp, indic )      ! ocean model: outputs 
     388 
     389      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     390      ! Assimilation mode 
     391      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     392 
     393         IF( ln_trjwri ) CALL tam_trj_wri( kstp )          ! Output trajectory fields 
     394 
    357395      ENDIF 
    358396 
Note: See TracChangeset for help on using the changeset viewer.