Changeset 2392
- Timestamp:
- 2010-11-15T22:20:05+01:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 deleted
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r2287 r2392 5 5 !! assimilation 6 6 !!====================================================================== 7 !! History : ! 2007-03 (M. Martin) Met Office version 8 !! ! 2007-04 (A. Weaver) calc_date original code 9 !! ! 2007-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 10 !! NEMO 3.3 ! 2010-05 (D. Lea) Update to work with NEMO v3.2 11 !! - ! 2010-05 (D. Lea) add calc_month_len routine based on day_init 12 !!---------------------------------------------------------------------- 7 13 8 14 !!---------------------------------------------------------------------- … … 15 21 !! ssh_asm_inc : Apply the SSH increment 16 22 !!---------------------------------------------------------------------- 17 !! * Modules used 18 USE par_kind, ONLY : & ! Precision variables 19 & wp 20 USE in_out_manager, ONLY : & ! I/O manager 21 & lwp, & 22 & numnam, & 23 & numout, & 24 & ctl_warn, & 25 & ctl_stop, & 26 & nit000, & 27 & nstop, & 28 & ln_rstart 29 USE par_oce, ONLY : & ! Ocean space and time domain variables 30 & jpi, & 31 & jpj, & 32 & jpk, & 33 & jpkm1 34 USE dom_oce, ONLY : & ! Ocean space and time domain 35 & rdt, & 36 & n_cla, & 37 & neuler, & 38 & ln_zps, & 39 & tmask, & 40 & umask, & 41 & vmask 23 USE in_out_manager ! I/O manager 24 USE par_oce ! Ocean space and time domain variables 25 USE dom_oce ! Ocean space and time domain 26 USE oce ! Dynamics and active tracers defined in memory 27 USE divcur ! Horizontal divergence and relative vorticity 28 USE eosbn2 ! Equation of state - in situ and potential density 29 USE zpshde ! Partial step : Horizontal Derivative 30 USE iom ! Library to read input files 31 USE asmpar ! Parameters for the assmilation interface 42 32 #if defined key_c1d 43 USE c1d, ONLY : & ! 1D initialization 44 & lk_c1d 33 USE c1d, ONLY : lk_c1d ! 1D initialization 45 34 #endif 46 USE oce, ONLY : & ! Dynamics and active tracers defined in memory47 & ub, un, ua, &48 & vb, vn, va, &49 & tsb, tsn, tsa, &50 & sshb, sshn, &51 & rhd, rhop, &52 & rotb, rotn, &53 & hdivb, hdivn, &54 & gtsu, gru, &55 & gtsv, grv56 USE divcur, ONLY : & ! Horizontal divergence and relative vorticity57 & div_cur58 USE cla_div, ONLY : & ! Specific update of the horizontal divergence59 & div_cla ! (specific to ORCA_R2)60 USE eosbn2, ONLY : & ! Equation of state - in situ and potential density61 & eos62 USE zpshde, ONLY : & ! Partial step : Horizontal Derivative63 & zps_hde64 ! USE phycst, ONLY : & ! Calendar parameters65 ! & rjjss66 USE iom ! Library to read input files67 USE asmpar ! Parameters for the assmilation interface68 USE dom_oce, ONLY : &69 & ndastp70 ! USE daymod, ONLY : &71 ! & nmonth_len ! length of month in days72 ! & nbiss, &73 ! & nobis, &74 75 35 76 36 IMPLICIT NONE 77 78 !! * Routine accessibility79 37 PRIVATE 80 PUBLIC asm_inc_init, & !: Initialize the increment arrays and IAU weights 81 & calc_date, & !: Compute the calendar date YYYYMMDD on a given step 82 & tra_asm_inc, & !: Apply the tracer (T and S) increments 83 & dyn_asm_inc, & !: Apply the dynamic (u and v) increments 84 & ssh_asm_inc !: Apply the SSH increment 85 86 !! * Private Module variables 87 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: & 88 & t_bkg, & !: Background temperature 89 & s_bkg, & !: Background salinity 90 & u_bkg, & !: Background u-component velocity 91 & v_bkg, & !: Background v-component velocity 92 & t_bkginc, & !: Increment to the background temperature 93 & s_bkginc, & !: Increment to the background salinity 94 & u_bkginc, & !: Increment to the u-component velocity 95 & v_bkginc !: Increment to the v-component velocity 96 97 REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: & 98 & ssh_bkg, & !: Background sea surface height 99 & ssh_bkginc !: Increment to the background sea surface height 100 101 REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 102 & wgtiau !: IAU weights for each time step 103 104 !! * Shared Module variables 105 LOGICAL, PUBLIC, PARAMETER :: & 38 39 PUBLIC asm_inc_init !: Initialize the increment arrays and IAU weights 40 PUBLIC calc_date !: Compute the calendar date YYYYMMDD on a given step 41 PUBLIC tra_asm_inc !: Apply the tracer (T and S) increments 42 PUBLIC dyn_asm_inc !: Apply the dynamic (u and v) increments 43 PUBLIC ssh_asm_inc !: Apply the SSH increment 44 106 45 #if defined key_asminc 107 &lk_asminc = .TRUE. !: Logical switch for assimilation increment interface46 LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .TRUE. !: Logical switch for assimilation increment interface 108 47 #else 109 &lk_asminc = .FALSE. !: No assimilation increments48 LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE. !: No assimilation increments 110 49 #endif 111 112 50 LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 113 51 LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields … … 119 57 LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 120 58 121 REAL, PUBLIC :: salfixmin !: Ensure that the salinity is larger than 122 ! !: this value if (ln_salfix) 59 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: t_bkg , s_bkg !: Background temperature and salinity 60 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: u_bkg , v_bkg !: Background u- & v- velocity components 61 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: t_bkginc, s_bkginc !: Increment to the background T & S 62 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: u_bkginc, v_bkginc !: Increment to the u- & v-components 63 REAL(wp), PUBLIC, DIMENSION(:) , ALLOCATABLE :: wgtiau !: IAU weights for each time step 123 64 #if defined key_asminc 124 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & 125 & ssh_iau !: IAU-weighted sea surface height increment 65 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ssh_iau !: IAU-weighted sea surface height increment 126 66 #endif 127 128 INTEGER, PUBLIC :: nitbkg !: Time step of the background state used in the Jb term 129 !: (relative to the cycle interval [0,nitend-nit000-1]) 130 INTEGER, PUBLIC :: nitdin !: Time step of the background state for direct initialization 131 !: (relative to the cycle interval [0,nitend-nit000-1]) 132 INTEGER, PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 133 !: (relative to the cycle interval [0,nitend-nit000-1]) 134 INTEGER, PUBLIC :: nitiaufin !: Time step of the end of the IAU interval 135 !: (relative to the cycle interval [0,nitend-nit000-1]) 136 INTEGER, PUBLIC :: niaufn !: Type of IAU weighing function 137 !: 0 = Constant weighting 138 !: 1 = Linear hat-like, centred in middle of IAU interval 67 ! !!! time steps relative to the cycle interval [0,nitend-nit000-1] 68 INTEGER , PUBLIC :: nitbkg !: Time step of the background state used in the Jb term 69 INTEGER , PUBLIC :: nitdin !: Time step of the background state for direct initialization 70 INTEGER , PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 71 INTEGER , PUBLIC :: nitiaufin !: Time step of the end of the IAU interval 72 ! 73 INTEGER , PUBLIC :: niaufn !: Type of IAU weighing function: = 0 Constant weighting 74 ! !: = 1 Linear hat-like, centred in middle of IAU interval 75 REAL(wp), PUBLIC :: salfixmin !: Ensure that the salinity is larger than this value if (ln_salfix) 76 77 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ssh_bkg, ssh_bkginc ! Background sea surface height and its increment 139 78 140 79 !!---------------------------------------------------------------------- 141 80 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 142 81 !! $Id$ 143 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)82 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 144 83 !!---------------------------------------------------------------------- 145 146 84 CONTAINS 147 85 … … 155 93 !! 156 94 !! ** Action : 157 !! 158 !! History : 159 !! ! 07-03 (M. Martin) Met Office version 160 !! ! 07-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 161 !!---------------------------------------------------------------------- 162 163 IMPLICIT NONE 164 165 !! * Modules used 166 NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, & 167 & ln_trainc, ln_dyninc, ln_sshinc, & 168 & ln_asmdin, ln_asmiau, & 169 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 170 & nittrjfrq, ln_salfix, salfixmin 171 172 !! * Local declarations 95 !!---------------------------------------------------------------------- 173 96 INTEGER :: jt 174 175 97 INTEGER :: imid 176 98 INTEGER :: inum … … 190 112 REAL(wp) :: zdate_bkg ! Date in background state file for DI 191 113 REAL(wp) :: zdate_inc ! Time axis in increments file 114 !! 115 NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, & 116 & ln_trainc, ln_dyninc, ln_sshinc, & 117 & ln_asmdin, ln_asmiau, & 118 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 119 & nittrjfrq, ln_salfix, salfixmin 120 !!---------------------------------------------------------------------- 192 121 193 122 !----------------------------------------------------------------------- … … 220 149 WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 221 150 WRITE(numout,*) '~~~~~~~~~~~~' 222 WRITE(numout,*) ' Namelist namasm : set assimilation increment parameters' 223 WRITE(numout,*) ' Logical switch for writing out background state ', & 224 & ' ln_bkgwri = ', ln_bkgwri 225 WRITE(numout,*) ' Logical switch for writing out state trajectory ', & 226 & ' ln_trjwri = ', ln_trjwri 227 WRITE(numout,*) ' Logical switch for applying tracer increments ', & 228 & ' ln_trainc = ', ln_trainc 229 WRITE(numout,*) ' Logical switch for applying velocity increments ', & 230 & ' ln_dyninc = ', ln_dyninc 231 WRITE(numout,*) ' Logical switch for applying SSH increments ', & 232 & ' ln_sshinc = ', ln_sshinc 233 WRITE(numout,*) ' Logical switch for Direct Initialization (DI) ', & 234 & ' ln_asmdin = ', ln_asmdin 235 WRITE(numout,*) ' Logical switch for Incremental Analysis Updating (IAU) ', & 236 & ' ln_asmiau = ', ln_asmiau 237 WRITE(numout,*) ' Timestep of background in [0,nitend-nit000-1] ', & 238 & ' nitbkg = ', nitbkg 239 WRITE(numout,*) ' Timestep of background for DI in [0,nitend-nit000-1] ', & 240 & ' nitdin = ', nitdin 241 WRITE(numout,*) ' Timestep of start of IAU interval in [0,nitend-nit000-1]', & 242 & ' nitiaustr = ', nitiaustr 243 WRITE(numout,*) ' Timestep of end of IAU interval in [0,nitend-nit000-1] ', & 244 & ' nitiaufin = ', nitiaufin 245 WRITE(numout,*) ' Type of IAU weighting function ', & 246 & ' niaufn = ', niaufn 247 WRITE(numout,*) ' Frequency of trajectory output for 4D-VAR ', & 248 & ' nittrjfrq = ', nittrjfrq 249 WRITE(numout,*) ' Logical switch for ensuring that the sa > salfixmin ', & 250 & ' ln_salfix = ', ln_salfix 251 WRITE(numout,*) ' Minimum salinity after applying the increments ', & 252 & ' salfixmin = ', salfixmin 151 WRITE(numout,*) ' Namelist namasm : set assimilation increment parameters' 152 WRITE(numout,*) ' Logical switch for writing out background state ln_bkgwri = ', ln_bkgwri 153 WRITE(numout,*) ' Logical switch for writing out state trajectory ln_trjwri = ', ln_trjwri 154 WRITE(numout,*) ' Logical switch for applying tracer increments ln_trainc = ', ln_trainc 155 WRITE(numout,*) ' Logical switch for applying velocity increments ln_dyninc = ', ln_dyninc 156 WRITE(numout,*) ' Logical switch for applying SSH increments ln_sshinc = ', ln_sshinc 157 WRITE(numout,*) ' Logical switch for Direct Initialization (DI) ln_asmdin = ', ln_asmdin 158 WRITE(numout,*) ' Logical switch for Incremental Analysis Updating (IAU) ln_asmiau = ', ln_asmiau 159 WRITE(numout,*) ' Timestep of background in [0,nitend-nit000-1] nitbkg = ', nitbkg 160 WRITE(numout,*) ' Timestep of background for DI in [0,nitend-nit000-1] nitdin = ', nitdin 161 WRITE(numout,*) ' Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 162 WRITE(numout,*) ' Timestep of end of IAU interval in [0,nitend-nit000-1] nitiaufin = ', nitiaufin 163 WRITE(numout,*) ' Type of IAU weighting function niaufn = ', niaufn 164 WRITE(numout,*) ' Frequency of trajectory output for 4D-VAR nittrjfrq = ', nittrjfrq 165 WRITE(numout,*) ' Logical switch for ensuring that the sa > salfixmin ln_salfix = ', ln_salfix 166 WRITE(numout,*) ' Minimum salinity after applying the increments salfixmin = ', salfixmin 253 167 ENDIF 254 168 … … 565 479 566 480 ENDIF 567 481 ! 568 482 END SUBROUTINE asm_inc_init 483 569 484 570 485 SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) … … 577 492 !! 578 493 !! ** Action : 579 !! 580 !! History : 581 !! ! 07-04 (A. Weaver) 582 !! ! 10-05 (D. Lea) Update to work with NEMO vn3.2 583 !!---------------------------------------------------------------------- 584 585 IMPLICIT NONE 586 587 !! * Arguments 588 494 !!---------------------------------------------------------------------- 589 495 INTEGER, INTENT(IN) :: kit000 ! Initial time step 590 496 INTEGER, INTENT(IN) :: kt ! Current time step referenced to kit000 591 497 INTEGER, INTENT(IN) :: kdate0 ! Initial date 592 498 INTEGER, INTENT(OUT) :: kdate ! Current date reference to kdate0 593 594 !! * Local declarations 595 499 ! 596 500 INTEGER :: iyea0 ! Initial year 597 501 INTEGER :: imon0 ! Initial month … … 648 552 idaycnt = idaycnt + 1 649 553 END DO 650 554 ! 651 555 kdate = iyea * 10000 + imon * 100 + iday 652 556 ! 653 557 END SUBROUTINE 558 654 559 655 560 SUBROUTINE calc_month_len( iyear, imonth_len ) … … 660 565 !! 661 566 !! ** Method : 662 !! 663 !! ** Action : 664 !! 665 !! History : 666 !! ! 10-05 (D. Lea) New routine based on day_init 667 !!---------------------------------------------------------------------- 668 567 !!---------------------------------------------------------------------- 669 568 INTEGER, DIMENSION(12) :: imonth_len !: length in days of the months of the current year 670 569 INTEGER :: iyear !: year 671 570 !!---------------------------------------------------------------------- 571 ! 672 572 ! length of the month of the current year (from nleapy, read in namelist) 673 573 IF ( nleapy < 2 ) THEN … … 681 581 imonth_len(:) = nleapy ! all months with nleapy days per year 682 582 ENDIF 683 583 ! 684 584 END SUBROUTINE 585 685 586 686 587 SUBROUTINE tra_asm_inc( kt ) … … 693 594 !! 694 595 !! ** Action : 695 !! 696 !! History : 697 !! ! 07-03 (M. Martin) Met Office version 698 !! ! 07-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 699 !!---------------------------------------------------------------------- 700 701 IMPLICIT NONE 702 703 !! * Arguments 596 !!---------------------------------------------------------------------- 704 597 INTEGER, INTENT(IN) :: kt ! Current time step 705 706 !! * Local declarations 598 ! 707 599 INTEGER :: ji,jj,jk 708 600 INTEGER :: it 709 601 REAL(wp) :: zincwgt ! IAU weight for current time step 602 !!---------------------------------------------------------------------- 710 603 711 604 IF ( ln_asmiau ) THEN … … 793 686 DEALLOCATE( s_bkg ) 794 687 ENDIF 795 796 ENDIF 797 688 ! 689 ENDIF 690 ! 798 691 END SUBROUTINE tra_asm_inc 692 799 693 800 694 SUBROUTINE dyn_asm_inc( kt ) … … 807 701 !! 808 702 !! ** Action : 809 !! 810 !! History : 811 !! ! 07-03 (M. Martin) Met Office version 812 !! ! 07-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 813 !!---------------------------------------------------------------------- 814 815 IMPLICIT NONE 816 817 !! * Arguments 703 !!---------------------------------------------------------------------- 818 704 INTEGER, INTENT(IN) :: kt ! Current time step 819 820 !! * Local declarations 705 ! 821 706 INTEGER :: jk 822 707 INTEGER :: it 823 708 REAL(wp) :: zincwgt ! IAU weight for current time step 709 !!---------------------------------------------------------------------- 824 710 825 711 IF ( ln_asmiau ) THEN … … 871 757 vb(:,:,:) = vn(:,:,:) 872 758 873 CALL div_cur( kt ) ! Compute divergence and curl for now fields 874 IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 759 CALL div_cur( kt ) ! Compute divergence and curl for now fields 875 760 876 761 rotb (:,:,:) = rotn (:,:,:) ! Update before fields … … 881 766 DEALLOCATE( u_bkginc ) 882 767 DEALLOCATE( v_bkginc ) 883 884 ENDIF 885 886 ENDIF 887 768 ENDIF 769 ! 770 ENDIF 771 ! 888 772 END SUBROUTINE dyn_asm_inc 773 889 774 890 775 SUBROUTINE ssh_asm_inc( kt ) … … 897 782 !! 898 783 !! ** Action : 899 !! 900 !! History : 901 !! ! 07-03 (M. Martin) Met Office version 902 !! ! 07-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 903 !!---------------------------------------------------------------------- 904 905 IMPLICIT NONE 906 907 !! * Arguments 784 !!---------------------------------------------------------------------- 908 785 INTEGER, INTENT(IN) :: kt ! Current time step 909 910 !! * Local declarations 786 ! 911 787 INTEGER :: it 912 788 REAL(wp) :: zincwgt ! IAU weight for current time step 789 !!---------------------------------------------------------------------- 913 790 914 791 IF ( ln_asmiau ) THEN … … 960 837 961 838 ENDIF 962 963 ENDIF 964 839 ! 840 ENDIF 841 ! 965 842 END SUBROUTINE ssh_asm_inc 966 843 844 !!====================================================================== 967 845 END MODULE asminc -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2304 r2392 55 55 ! !!* Namelist namcla : cross land advection 56 56 INTEGER, PUBLIC :: nn_cla = 0 !: =1 cross land advection for exchanges through some straits (ORCA2) 57 58 ! ! old non-DOCTOR names still used in the model59 INTEGER, PUBLIC :: n_cla = 0 !: =1 cross land advection for exchanges through some straits (ORCA2)60 57 61 58 !!---------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r2382 r2392 243 243 ENDIF 244 244 245 n_cla = nn_cla ! conversion DOCTOR names into model names (this should disappear soon)246 247 IF( lk_mpp_rep .AND. n_cla /= 0 ) CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )248 !249 250 245 #if defined key_netcdf4 251 246 ! ! NetCDF 4 case ("key_netcdf4" defined) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r2380 r2392 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : ! 88-03 (G. Madec) 7 !! ! 91-11 (G. Madec) 8 !! ! 92-06 (M. Imbard) 9 !! ! 96-01 (G. Madec) terrain following coordinates 10 !! ! 97-02 (G. Madec) print mesh informations 11 !! ! 99-11 (M. Imbard) NetCDF format with IO-IPSL 12 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb 13 !! ! 01-09 (M. Levy) eel config: grid in km, beta-plane 14 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module, namelist 15 !! 9.0 ! 04-01 (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 16 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 17 !! ! 04-05 (A. Koch-Larrouy) Add Gyre configuration 6 !! History : OPA ! 1988-03 (G. Madec) Original code 7 !! 7.0 ! 1996-01 (G. Madec) terrain following coordinates 8 !! 8.0 ! 1997-02 (G. Madec) print mesh informations 9 !! 8.1 ! 1999-11 (M. Imbard) NetCDF format with IO-IPSL 10 !! 8.2 ! 2000-08 (D. Ludicone) Reduced section at Bab el Mandeb 11 !! - ! 2001-09 (M. Levy) eel config: grid in km, beta-plane 12 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module, namelist 13 !! - ! 2004-01 (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 14 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 15 !! - ! 2004-05 (A. Koch-Larrouy) Add Gyre configuration 18 16 !!---------------------------------------------------------------------- 19 17 20 18 !!---------------------------------------------------------------------- 21 !! dom_hgr 22 !! hgr_read 19 !! dom_hgr : initialize the horizontal mesh 20 !! hgr_read : read "coordinate" NetCDF file 23 21 !!---------------------------------------------------------------------- 24 !! * Modules used 25 USE dom_oce ! ocean space and time domain 26 USE phycst ! physical constants 27 USE in_out_manager ! I/O manager 28 USE lib_mpp 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 29 26 30 27 IMPLICIT NONE 31 28 PRIVATE 32 29 33 !! * Module variables 34 REAL(wp) :: glam0, gphi0 ! variables corresponding to parameters 35 ! ! ppglam0 ppgphi0 set in par_oce 36 37 !! * Routine accessibility 38 PUBLIC dom_hgr ! called by domain.F90 30 REAL(wp) :: glam0, gphi0 ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 31 32 PUBLIC dom_hgr ! called by domain.F90 33 39 34 !!---------------------------------------------------------------------- 40 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 41 36 !! $Id$ 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 38 !!---------------------------------------------------------------------- 44 45 39 CONTAINS 46 40 … … 100 94 !! Madec, Imbard, 1996, Clim. Dyn. 101 95 !!---------------------------------------------------------------------- 102 INTEGER :: ji, jj ! dummy loop indices 103 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 104 INTEGER :: ijeq ! index of equator T point (used in case 4) 105 REAL(wp) :: & 106 zti, zui, zvi, zfi, & ! temporary scalars 107 ztj, zuj, zvj, zfj, & ! 108 zphi0, zbeta, znorme, & ! 109 zarg, zf0, zminff, zmaxff 110 REAL(wp) :: & 111 zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg, & 112 zphi1, zsin_alpha, zim05, zjm05 96 INTEGER :: ji, jj ! dummy loop indices 97 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 98 INTEGER :: ijeq ! index of equator T point (used in case 4) 99 REAL(wp) :: zti, zui, zvi, zfi ! local scalars 100 REAL(wp) :: ztj, zuj, zvj, zfj ! - - 101 REAL(wp) :: zphi0, zbeta, znorme ! 102 REAL(wp) :: zarg, zf0, zminff, zmaxff 103 REAL(wp) :: zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg 104 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 113 105 !!---------------------------------------------------------------------- 114 106 … … 138 130 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 139 131 ! ! ===================== 140 IF( n _cla == 0 ) THEN132 IF( nn_cla == 0 ) THEN 141 133 ! 142 134 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u = 20 km) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2380 r2392 5 5 !!====================================================================== 6 6 !! History : OPA ! 1987-07 (G. Madec) Original code 7 !! -! 1993-03 (M. Guyon) symetrical conditions (M. Guyon)8 !! -! 1996-01 (G. Madec) suppression of common work arrays7 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 !! 7.0 ! 1996-01 (G. Madec) suppression of common work arrays 9 9 !! - ! 1996-05 (G. Madec) mask computed from tmask and sup- 10 10 !! ! pression of the double computation of bmask 11 !! -! 1997-02 (G. Madec) mesh information put in domhgr.F12 !! -! 1997-07 (G. Madec) modification of mbathy and fmask11 !! 8.0 ! 1997-02 (G. Madec) mesh information put in domhgr.F 12 !! 8.1 ! 1997-07 (G. Madec) modification of mbathy and fmask 13 13 !! - ! 1998-05 (G. Roullet) free surface 14 !! -! 2000-03 (G. Madec) no slip accurate14 !! 8.2 ! 2000-03 (G. Madec) no slip accurate 15 15 !! - ! 2001-09 (J.-M. Molines) Open boundaries 16 16 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module … … 44 44 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 !!---------------------------------------------------------------------- 48 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 !!---------------------------------------------------------------------- 49 48 CONTAINS 50 49 … … 132 131 ENDIF 133 132 134 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral free-slip '133 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral free-slip ' 135 134 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral no-slip ' 136 135 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral partial-slip ' … … 308 307 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 309 308 ! ! Increased lateral friction near of some straits 310 IF( n _cla == 0 ) THEN309 IF( nn_cla == 0 ) THEN 311 310 ! ! Gibraltar strait : partial slip (fmask=0.5) 312 311 ij0 = 101 ; ij1 = 101 … … 322 321 ! 323 322 ENDIF 324 325 323 ! ! Danish straits : strong slip (fmask > 2) 326 324 ! We keep this as an example but it is instable in this case … … 331 329 ! 332 330 ENDIF 333 ! ! ===================== 334 IF( cp_cfg == "orca" .AND. jp_cfg .eq. 1 ) THEN ! ORCA R1 configuration 335 ! ! ===================== 336 337 ii0 = 283 ; ii1 = 284 ! Gibraltar Strait 338 ij0 = 200 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 339 IF(lwp) WRITE(numout,*) 340 IF(lwp) WRITE(numout,*) ' orca_r1: Gibraltar : ' 341 342 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 343 ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 344 IF(lwp) WRITE(numout,*) 345 IF(lwp) WRITE(numout,*) ' orca_r1: Bhosporus : ' 346 347 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 348 ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 349 IF(lwp) WRITE(numout,*) 350 IF(lwp) WRITE(numout,*) ' orca_r1: Makassar (Top) : ' 351 352 ii0 = 44 ; ii1 = 44 ! Lombok Strait 353 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 354 IF(lwp) WRITE(numout,*) 355 IF(lwp) WRITE(numout,*) ' orca_r1: Lombok : ' 356 357 ii0 = 53 ; ii1 = 53 ! Ombai Strait 358 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 359 IF(lwp) WRITE(numout,*) 360 IF(lwp) WRITE(numout,*) ' orca_r1: Ombai : ' 361 362 ii0 = 56 ; ii1 = 56 ! Timor Passage 363 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 364 IF(lwp) WRITE(numout,*) 365 IF(lwp) WRITE(numout,*) ' orca_r1: ' 366 367 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 368 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 369 IF(lwp) WRITE(numout,*) 370 IF(lwp) WRITE(numout,*) ' orca_r1: West Halmahera : ' 371 372 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 373 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 374 IF(lwp) WRITE(numout,*) 375 IF(lwp) WRITE(numout,*) ' orca_r1: East Halmahera : ' 376 377 ! 378 ! 379 ENDIF 331 ! 332 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 333 ! ! Increased lateral friction near of some straits 334 IF(lwp) WRITE(numout,*) 335 IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : ' 336 IF(lwp) WRITE(numout,*) ' Gibraltar ' 337 ii0 = 283 ; ii1 = 284 ! Gibraltar Strait 338 ij0 = 200 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 339 340 IF(lwp) WRITE(numout,*) ' Bhosporus ' 341 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 342 ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 343 344 IF(lwp) WRITE(numout,*) ' Makassar (Top) ' 345 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 346 ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 347 348 IF(lwp) WRITE(numout,*) ' Lombok ' 349 ii0 = 44 ; ii1 = 44 ! Lombok Strait 350 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 351 352 IF(lwp) WRITE(numout,*) ' Ombai ' 353 ii0 = 53 ; ii1 = 53 ! Ombai Strait 354 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 355 356 IF(lwp) WRITE(numout,*) ' Timor Passage ' 357 ii0 = 56 ; ii1 = 56 ! Timor Passage 358 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0 359 360 IF(lwp) WRITE(numout,*) ' West Halmahera ' 361 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 362 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 363 364 IF(lwp) WRITE(numout,*) ' East Halmahera ' 365 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 366 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0 367 ! 368 ENDIF 380 369 ! 381 370 CALL lbc_lnk( fmask, 'F', 1. ) ! Lateral boundary conditions on fmask -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2380 r2392 412 412 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 413 413 ! ! ===================== 414 IF( n_cla == 0 ) THEN 415 ! 414 IF( nn_cla == 0 ) THEN 416 415 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open 417 416 ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995) … … 422 421 END DO 423 422 IF(lwp) WRITE(numout,*) 424 IF(lwp) WRITE(numout,*) ' 423 IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 425 424 ! 426 425 ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open … … 432 431 END DO 433 432 IF(lwp) WRITE(numout,*) 434 IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 435 ! 433 IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 436 434 ENDIF 437 435 ! … … 443 441 CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 444 442 CALL iom_close (inum) 445 !! =====================443 ! ! ===================== 446 444 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 447 ii0 = 142 ; ii1 = 142 ! Close Halmera Strait448 ij0 = 51 ; ij1 = 53 ! =====================449 DO ji = mi0(ii0), mi1(ii1) 445 ii0 = 142 ; ii1 = 142 ! ===================== 446 ij0 = 51 ; ij1 = 53 447 DO ji = mi0(ii0), mi1(ii1) ! Close Halmera Strait 450 448 DO jj = mj0(ij0), mj1(ij1) 451 449 bathy(ji,jj) = 0.0 … … 453 451 END DO 454 452 IF(lwp) WRITE(numout,*) 455 IF(lwp) WRITE(numout,*) ' 453 IF(lwp) WRITE(numout,*) ' orca_r1: Halmera strait closed at i=',ii0,' j=',ij0,'->',ij1 456 454 ENDIF 457 455 ! ! ===================== 458 456 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 459 457 ! ! ===================== 460 IF( n_cla == 0 ) THEN 461 ! 462 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open 463 ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995) 458 IF( nn_cla == 0 ) THEN 459 ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open 460 ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995) 464 461 DO ji = mi0(ii0), mi1(ii1) 465 462 DO jj = mj0(ij0), mj1(ij1) … … 468 465 END DO 469 466 IF(lwp) WRITE(numout,*) 470 IF(lwp) WRITE(numout,*) ' 467 IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 471 468 ! 472 ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open473 ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995)469 ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open 470 ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995) 474 471 DO ji = mi0(ii0), mi1(ii1) 475 472 DO jj = mj0(ij0), mj1(ij1) … … 479 476 IF(lwp) WRITE(numout,*) 480 477 IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 481 !482 478 ENDIF 483 479 ! -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90
r2287 r2392 4 4 !! Ocean data : read ocean salinity data from monthly atlas data 5 5 !!===================================================================== 6 !! History : OPA ! 1991-03 () Original code 7 !! - ! 1992-07 (M. Imbard) 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 !!---------------------------------------------------------------------- 6 12 #if defined key_dtasal || defined key_esopa 7 13 !!---------------------------------------------------------------------- … … 10 16 !! dta_sal : read ocean salinity data 11 17 !!---------------------------------------------------------------------- 12 !! * Modules used13 18 USE oce ! ocean dynamics and tracers 14 19 USE dom_oce ! ocean space and time domain … … 23 28 PRIVATE 24 29 25 !! * Routine accessibility 26 PUBLIC dta_sal ! called by step.F90 and inidta.F90 30 PUBLIC dta_sal ! called by step.F90 and inidta.F90 27 31 28 !! * Shared module variables29 32 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 30 33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: s_dta !: salinity data at given time-step 31 34 32 !! * Module variables33 35 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal ! structure of input SST (file informations, fields read) 34 36 … … 38 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 41 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 43 44 CONTAINS 44 45 !!----------------------------------------------------------------------46 !! Default option: NetCDF file47 !!----------------------------------------------------------------------48 45 49 46 SUBROUTINE dta_sal( kt ) … … 54 51 !! 55 52 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 56 !! lated onto the model grid.53 !! lated onto the model grid. 57 54 !! - At each time step, a linear interpolation is applied 58 !! between two monthly values. 59 !! 60 !! History : 61 !! ! 91-03 () Original code 62 !! ! 92-07 (M. Imbard) 63 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 55 !! between two monthly values. 64 56 !!---------------------------------------------------------------------- 65 57 INTEGER, INTENT(in) :: kt ! ocean time step 66 58 ! 67 59 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 68 60 INTEGER :: ik, ierror ! temporary integers … … 71 63 #endif 72 64 REAL(wp):: zl 73 74 65 #if defined key_orca_lev10 75 66 INTEGER :: ikr, ikw, ikt, jjk … … 80 71 TYPE(FLD_N) :: sn_sal 81 72 LOGICAL , SAVE :: linit_sal = .FALSE. 73 !! 74 NAMELIST/namdta_sal/ cn_dir, sn_sal 82 75 !!---------------------------------------------------------------------- 83 NAMELIST/namdta_sal/cn_dir,sn_sal84 76 85 77 ! 1. Initialization … … 91 83 cn_dir = './' ! directory in which the model is executed 92 84 ! ... default values (NB: frequency positive => hours, negative => months) 93 ! ! file ! frequency ! variable! time intep ! clim ! 'yearly' or ! weights ! rotation !94 ! ! name ! (hours) ! name! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !95 sn_sal = FLD_N( 'salinity', -1. ,'vosaline', .false. , .true. , 'monthly' , '' , '' )96 97 REWIND ( numnam ) ! ...read in namlist namdta_sal85 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 86 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 87 sn_sal = FLD_N( 'salinity', -1. ,'vosaline', .false. , .true. , 'monthly' , '' , '' ) 88 89 REWIND ( numnam ) ! read in namlist namdta_sal 98 90 READ( numnam, namdta_sal ) 99 91 … … 115 107 IF( sn_sal%ln_tint ) ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 116 108 #endif 117 ! fill sf_sal with sn_sal and control print109 ! ! fill sf_sal with sn_sal and control print 118 110 CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 119 111 linit_sal = .TRUE. … … 132 124 133 125 #if defined key_tradmp 134 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 135 136 ! ! ======================= 137 ! ! ORCA_R2 configuration 138 ! ! ======================= 126 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 127 ! 139 128 ij0 = 101 ; ij1 = 109 140 129 ii0 = 141 ; ii1 = 155 … … 147 136 END DO 148 137 END DO 149 150 IF( n _cla == 1 ) THEN138 ! 139 IF( nn_cla == 1 ) THEN 151 140 ! ! New salinity profile at Gibraltar 152 141 il0 = 138 ; il1 = 138 … … 230 219 ! ! Mask 231 220 s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 232 s_dta(:,:,jpk) = 0. 221 s_dta(:,:,jpk) = 0.e0 233 222 IF( ln_zps ) THEN ! z-coord. partial steps 234 223 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) … … 254 243 CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 255 244 ENDIF 256 245 ! 257 246 END SUBROUTINE dta_sal 258 247 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
r2287 r2392 4 4 !! Ocean data : read ocean temperature data from monthly atlas data 5 5 !!===================================================================== 6 !! History : OPA ! 1991-03 () Original code 7 !! - ! 1992-07 (M. Imbard) 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 !!---------------------------------------------------------------------- 6 12 #if defined key_dtatem || defined key_esopa 7 13 !!---------------------------------------------------------------------- … … 10 16 !! dta_tem : read ocean temperature data 11 17 !!---l------------------------------------------------------------------- 12 !! * Modules used13 18 USE oce ! ocean dynamics and tracers 14 19 USE dom_oce ! ocean space and time domain … … 22 27 PRIVATE 23 28 24 !! * Routine accessibility 25 PUBLIC dta_tem ! called by step.F90 and inidta.F90 26 27 !! * Shared module variables 29 PUBLIC dta_tem ! called by step.F90 and inidta.F90 30 28 31 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 29 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step 30 33 31 !! * Module variables32 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) 33 35 … … 37 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 38 40 !! $Id$ 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 42 43 CONTAINS 43 44 !!----------------------------------------------------------------------45 !! Default case NetCDF file46 !!----------------------------------------------------------------------47 44 48 45 SUBROUTINE dta_tem( kt ) … … 62 59 !! 63 60 !! ** Action : define t_dta array at time-step kt 64 !!65 !! History :66 !! ! 91-03 () Original code67 !! ! 92-07 (M. Imbard)68 !! ! 99-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT69 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module70 61 !!---------------------------------------------------------------------- 71 62 INTEGER, INTENT( in ) :: kt ! ocean time-step 72 63 ! 73 64 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 74 65 INTEGER :: ik, ierror ! temporary integers … … 85 76 TYPE(FLD_N) :: sn_tem 86 77 LOGICAL , SAVE :: linit_tem = .FALSE. 78 !! 79 NAMELIST/namdta_tem/ cn_dir, sn_tem 87 80 !!---------------------------------------------------------------------- 88 NAMELIST/namdta_tem/cn_dir,sn_tem89 81 90 82 ! 1. Initialization … … 96 88 cn_dir = './' ! directory in which the model is executed 97 89 ! ... default values (NB: frequency positive => hours, negative => months) 98 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation!99 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs!100 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '')101 102 REWIND( numnam ) ! ...read in namlist namdta_tem90 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 91 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 92 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 93 94 REWIND( numnam ) ! read in namlist namdta_tem 103 95 READ( numnam, namdta_tem ) 104 96 … … 120 112 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 121 113 #endif 122 ! fill sf_tem with sn_tem and control print114 ! ! fill sf_tem with sn_tem and control print 123 115 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 124 116 linit_tem = .TRUE. … … 138 130 139 131 #if defined key_tradmp 140 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 141 ! ! ======================= 142 ! ! ORCA_R2 configuration 143 ! ! ======================= 132 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 133 ! 144 134 ij0 = 101 ; ij1 = 109 145 135 ii0 = 141 ; ii1 = 155 … … 151 141 END DO 152 142 END DO 153 154 IF( n _cla == 1 ) THEN143 ! 144 IF( nn_cla == 1 ) THEN 155 145 ! ! New temperature profile at Gibraltar 156 146 il0 = 138 ; il1 = 138 … … 175 165 END DO 176 166 END DO 177 !178 167 ELSE 179 168 ! ! Reduced temperature at Red Sea … … 251 240 t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 252 241 ENDIF 253 END DO254 END DO255 ENDIF256 257 ENDIF258 259 IF( lwp .AND. kt == nit000 ) THEN260 WRITE(numout,*) ' temperature Levitus '261 WRITE(numout,*)262 WRITE(numout,*)' level = 1'263 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )264 WRITE(numout,*)' level = ', jpk/2265 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )266 WRITE(numout,*)' level = ', jpkm1267 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )268 ENDIF269 242 END DO 243 END DO 244 ENDIF 245 ! 246 ENDIF 247 248 IF( lwp .AND. kt == nit000 ) THEN 249 WRITE(numout,*) ' temperature Levitus ' 250 WRITE(numout,*) 251 WRITE(numout,*)' level = 1' 252 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 253 WRITE(numout,*)' level = ', jpk/2 254 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 255 WRITE(numout,*)' level = ', jpkm1 256 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 257 ENDIF 258 ! 270 259 END SUBROUTINE dta_tem 271 260 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r2287 r2392 4 4 !! Ocean diagnostic variable : horizontal divergence and relative vorticity 5 5 !!============================================================================== 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code 7 !! 4.0 ! 1991-11 (G. Madec) 8 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions 9 !! 7.0 ! 1996-01 (G. Madec) s-coordinates 10 !! 8.0 ! 1997-06 (G. Madec) lateral boundary cond., lbc 11 !! 8.1 ! 1997-08 (J.M. Molines) Open boundaries 12 !! 8.2 ! 2000-03 (G. Madec) no slip accurate 13 !! NEMO 1.0 ! 2002-09 (G. Madec, E. Durand) Free form, F90 14 !! - ! 2005-01 (J. Chanut) Unstructured open boundaries 15 !! - ! 2003-08 (G. Madec) merged of cur and div, free form, F90 16 !! - ! 2005-01 (J. Chanut, A. Sellar) unstructured open boundaries 17 !! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 18 !! - ! 2010-10 (R. Furner, G. Madec) runoff and cla added directly here 19 !!---------------------------------------------------------------------- 6 20 7 21 !!---------------------------------------------------------------------- … … 9 23 !! vorticity fields 10 24 !!---------------------------------------------------------------------- 11 !! * Modules used12 25 USE oce ! ocean dynamics and tracers 13 26 USE dom_oce ! ocean space and time domain 27 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean 28 USE sbcrnf ! river runoff 29 USE obc_oce ! ocean lateral open boundary condition 30 USE cla ! cross land advection (cla_div routine) 14 31 USE in_out_manager ! I/O manager 15 USE obc_oce ! ocean lateral open boundary condition16 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 17 USE sbcrnf ! river runoff18 USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean19 33 20 34 IMPLICIT NONE 21 35 PRIVATE 22 36 23 !! * Accessibility 24 PUBLIC div_cur ! routine called by step.F90 and istate.F90 37 PUBLIC div_cur ! routine called by step.F90 and istate.F90 25 38 26 39 !! * Substitutions … … 30 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 31 44 !! $Id$ 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 !!---------------------------------------------------------------------- 34 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 35 47 CONTAINS 36 48 … … 48 60 !! vorticity at before and now time-step 49 61 !! 50 !! ** Method : 51 !! I. divergence : 62 !! ** Method : I. divergence : 52 63 !! - save the divergence computed at the previous time-step 53 64 !! (note that the Asselin filter has not been applied on hdivb) 54 65 !! - compute the now divergence given by : 55 66 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 56 !! above expression 57 !! - apply lateral boundary conditions on hdivn 58 !! II. vorticity : 67 !! correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 68 !! II. vorticity : 59 69 !! - save the curl computed at the previous time-step 60 70 !! rotb = rotn … … 62 72 !! - compute the now curl in tensorial formalism: 63 73 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 64 !! - apply lateral boundary conditions on rotn through a call65 !! of lbc_lnk routine.66 74 !! - Coastal boundary condition: 'key_noslip_accurate' defined, 67 75 !! the no-slip boundary condition is computed using Schchepetkin … … 69 77 !! For example, along east coast, the one-sided finite difference 70 78 !! approximation used for di[v] is: 71 !! di[e2v vn] = 1/(e1f*e2f) 72 !! * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 79 !! di[e2v vn] = 1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 73 80 !! 74 81 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 75 82 !! - update rotb , rotn , the before & now rel. vorticity 76 !! 77 !! History : 78 !! 8.2 ! 00-03 (G. Madec) no slip accurate 79 !! 9.0 ! 03-08 (G. Madec) merged of cur and div, free form, F90 80 !! ! 05-01 (J. Chanut, A. Sellar) unstructured open boundaries 81 !! NEMO 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 82 !!---------------------------------------------------------------------- 83 !! * Arguments 83 !!---------------------------------------------------------------------- 84 84 INTEGER, INTENT( in ) :: kt ! ocean time-step index 85 86 !! * Local declarations 85 ! 87 86 INTEGER :: ji, jj, jk ! dummy loop indices 88 87 INTEGER :: ii, ij, jl ! temporary integer … … 102 101 DO jk = 1, jpkm1 ! Horizontal slab 103 102 ! ! =============== 104 103 ! 105 104 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 106 105 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 107 106 ! 108 107 ! ! -------- 109 108 ! Horizontal divergence ! div … … 198 197 DO ji = 1, fs_jpim1 ! vector opt. 199 198 rotn(ji,jj,jk) = ( zwv(ji+1,jj ) - zwv(ji,jj) & 200 - zwu(ji ,jj+1) + zwu(ji,jj) ) & 201 * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 199 & - zwu(ji ,jj+1) + zwu(ji,jj) ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 202 200 END DO 203 201 END DO … … 228 226 * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 229 227 END DO 230 231 228 ! ! =============== 232 229 END DO ! End of slab 233 230 ! ! =============== 234 231 235 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 232 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 233 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (Update Hor. divergence) 236 234 237 235 ! 4. Lateral boundary conditions on hdivn and rotn 238 236 ! ---------------------------------=======---====== 239 CALL lbc_lnk( hdivn, 'T', 1. ) ! T-point, no sign change 240 CALL lbc_lnk( rotn , 'F', 1. ) ! F-point, no sign change 241 237 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 238 ! 242 239 END SUBROUTINE div_cur 243 240 … … 259 256 !! - compute the now divergence given by : 260 257 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 261 !! above expression 262 !! - apply lateral boundary conditions on hdivn 258 !! correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 263 259 !! - Relavtive Vorticity : 264 260 !! - save the curl computed at the previous time-step (rotb = rotn) … … 266 262 !! - compute the now curl in tensorial formalism: 267 263 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 268 !! - apply lateral boundary conditions on rotn through a call to269 !! routine lbc_lnk routine.270 264 !! Note: Coastal boundary condition: lateral friction set through 271 265 !! the value of fmask along the coast (see dommsk.F90) and shlat … … 274 268 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 275 269 !! - update rotb , rotn , the before & now rel. vorticity 276 !! 277 !! History : 278 !! 1.0 ! 87-06 (P. Andrich, D. L Hostis) Original code 279 !! 4.0 ! 91-11 (G. Madec) 280 !! 6.0 ! 93-03 (M. Guyon) symetrical conditions 281 !! 7.0 ! 96-01 (G. Madec) s-coordinates 282 !! 8.0 ! 97-06 (G. Madec) lateral boundary cond., lbc 283 !! 8.1 ! 97-08 (J.M. Molines) Open boundaries 284 !! 9.0 ! 02-09 (G. Madec, E. Durand) Free form, F90 285 !! ! 05-01 (J. Chanut) Unstructured open boundaries 286 !!---------------------------------------------------------------------- 287 !! * Arguments 270 !!---------------------------------------------------------------------- 288 271 INTEGER, INTENT( in ) :: kt ! ocean time-step index 289 290 !! * Local declarations 272 ! 291 273 INTEGER :: ji, jj, jk ! dummy loop indices 292 274 REAL(wp) :: zraur, zdep … … 302 284 DO jk = 1, jpkm1 ! Horizontal slab 303 285 ! ! =============== 304 286 ! 305 287 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 306 288 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 307 289 ! 308 290 ! ! -------- 309 291 ! Horizontal divergence ! div … … 312 294 DO ji = fs_2, fs_jpim1 ! vector opt. 313 295 hdivn(ji,jj,jk) = & 314 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj )*fse3u(ji-1,jj ,jk) * un(ji-1,jj,jk) &315 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji ,jj-1)*fse3v(ji ,jj-1,jk) * vn(ji,jj-1,jk) ) &296 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) & 297 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 316 298 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 317 299 END DO … … 349 331 ! ! =============== 350 332 351 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 333 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 334 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field) 352 335 353 336 ! 4. Lateral boundary conditions on hdivn and rotn 354 337 ! ---------------------------------=======---====== 355 CALL lbc_lnk( hdivn, 'T', 1. ) ! T-point, no sign change 356 CALL lbc_lnk( rotn , 'F', 1. ) ! F-point, no sign change 357 338 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 339 ! 358 340 END SUBROUTINE div_cur 359 341 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2338 r2392 164 164 ! ! Control of timestep choice 165 165 IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN 166 IF( n_cla == 1 ) & 167 & CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' ) 166 IF( nn_cla == 1 ) CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' ) 168 167 ENDIF 169 168 170 ! ! Control of momentum for ulation169 ! ! Control of momentum formulation 171 170 IF( lk_dynspg_ts .AND. lk_vvl ) THEN 172 IF( .NOT. ln_dynadv_vec ) & 173 & CALL ctl_stop( ' Flux formulae not implemented for this free surface formulation ' ) 171 IF( .NOT.ln_dynadv_vec ) CALL ctl_stop( 'Flux form not implemented for this free surface formulation' ) 174 172 ENDIF 175 173 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r2305 r2392 39 39 USE bdydyn ! Unstructured open boundaries condition (bdy_dyn routine) 40 40 USE bdyvol ! Unstructured open boundaries condition (bdy_vol routine) 41 USE cla _dynspg! cross land advection41 USE cla ! cross land advection 42 42 USE in_out_manager ! I/O manager 43 43 USE lib_mpp ! distributed memory computing library … … 199 199 CALL Agrif_dyn( kt ) ! Update velocities on each coarse/fine interfaces 200 200 #endif 201 #if defined key_orca_r2 202 IF( n_cla == 1 ) CALL dyn_spg_cla( kt ) ! Cross Land Advection (update (ua,va)) 203 #endif 201 IF( nn_cla == 1 ) CALL cla_dynspg( kt ) ! Cross Land Advection (update (ua,va)) 204 202 205 203 ! compute the next vertically averaged velocity (effect of the additional force not included) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2287 r2392 19 19 USE domvvl ! Variable volume 20 20 USE divcur ! hor. divergence and curl (div & cur routines) 21 USE cla_div ! cross land: hor. divergence (div_cla routine)22 21 USE iom ! I/O library 23 22 USE restart ! only for lrst_oce … … 147 146 ENDIF 148 147 ! 149 150 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 151 IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 152 148 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 149 ! 153 150 z2dt = 2. * rdt ! set time step size (Euler/Leapfrog) 154 151 IF( neuler == 0 .AND. kt == nit000 ) z2dt =rdt -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2287 r2392 21 21 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 22 22 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 23 USE cla ! cross land advection (cla_traadv routine) 23 24 USE ldftra_oce ! lateral diffusion coefficient on tracers 24 25 USE in_out_manager ! I/O manager … … 29 30 PRIVATE 30 31 31 PUBLIC tra_adv 32 PUBLIC tra_adv_init 32 PUBLIC tra_adv ! routine called by step module 33 PUBLIC tra_adv_init ! routine called by opa module 33 34 34 ! 35 LOGICAL :: ln_traadv_cen2 = .TRUE. 36 LOGICAL :: ln_traadv_tvd = .FALSE. 37 LOGICAL :: ln_traadv_muscl = .FALSE. 38 LOGICAL :: ln_traadv_muscl2 = .FALSE. 39 LOGICAL :: ln_traadv_ubs = .FALSE. 40 LOGICAL :: ln_traadv_qck = .FALSE. 35 ! !!* Namelist namtra_adv * 36 LOGICAL :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag 37 LOGICAL :: ln_traadv_tvd = .FALSE. ! TVD scheme flag 38 LOGICAL :: ln_traadv_muscl = .FALSE. ! MUSCL scheme flag 39 LOGICAL :: ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag 40 LOGICAL :: ln_traadv_ubs = .FALSE. ! UBS scheme flag 41 LOGICAL :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag 41 42 42 43 INTEGER :: nadv ! choice of the type of advection scheme 43 44 44 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 45 ! ! except at nit000 (=rdttra) if neuler=0 45 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 46 46 47 47 !! * Substitutions … … 51 51 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 52 52 !! $Id$ 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 54 54 !!---------------------------------------------------------------------- 55 56 55 CONTAINS 57 56 … … 65 64 !!---------------------------------------------------------------------- 66 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 67 ! !66 ! 68 67 INTEGER :: jk ! dummy loop index 69 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace: effective transport … … 75 74 r2dt(:) = 2. * rdttra(:) ! = 2 rdttra (leapfrog) 76 75 ENDIF 76 ! 77 IF( nn_cla == 1 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection) 78 ! 77 79 ! !== effective transport ==! 78 80 DO jk = 1, jpkm1 … … 84 86 ! 85 87 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 86 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)88 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 87 89 ! 88 90 CALL iom_put( "uoce_eff", zun ) ! output effective transport … … 97 99 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 98 100 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 99 100 101 ! 101 102 CASE (-1 ) !== esopa: test all possibility with control print ==! … … 118 119 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 119 120 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 120 !121 121 END SELECT 122 122 ! 123 123 ! ! print mean trends (used for debugging) 124 124 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & … … 137 137 INTEGER :: ioptio 138 138 !! 139 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &140 & ln_traadv_muscl, ln_traadv_muscl2, &139 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, & 140 & ln_traadv_muscl, ln_traadv_muscl2, & 141 141 & ln_traadv_ubs , ln_traadv_qck 142 142 !!---------------------------------------------------------------------- … … 156 156 WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs 157 157 WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck 158 ENDIF158 ENDIF 159 159 160 160 ioptio = 0 ! Parameter control … … 168 168 169 169 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' ) 170 171 IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) &172 & CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' )173 170 174 171 ! ! Set nadv -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r2364 r2392 757 757 END IF 758 758 759 IF( ( lk_trdmld ) .AND. ( n _cla == 1 ) ) THEN759 IF( ( lk_trdmld ) .AND. ( nn_cla == 1 ) ) THEN 760 760 WRITE(numout,cform_war) 761 761 WRITE(numout,*) ' You set n_cla = 1. Note that the Mixed-Layer diagnostics ' -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/cla.F90
r2287 r2392 1 1 MODULE cla 2 !!============================================================================== 3 !! *** MODULE cla *** 4 !! Cross Land Advection : parameterize ocean exchanges through straits by a 5 !! specified advection across land. 6 !!============================================================================== 2 !!====================================================================== 3 !! *** MODULE cla *** 4 !! Cross Land Advection : specific update of the horizontal divergence, 5 !! tracer trends and after velocity 6 !! 7 !! --- Specific to ORCA_R2 --- 8 !! 9 !!====================================================================== 10 !! History : 1.0 ! 2002-11 (A. Bozec) Original code 11 !! 3.2 ! 2009-07 (G. Madec) merge cla, cla_div, tra_cla, cla_dynspg 12 !! ! and correct a mpp bug reported by A.R. Porter 13 !!---------------------------------------------------------------------- 7 14 #if defined key_orca_r2 8 15 !!---------------------------------------------------------------------- 9 !! 'key_orca_r2' : ORCA R2 configuration16 !! 'key_orca_r2' global ocean model R2 10 17 !!---------------------------------------------------------------------- 11 !! tra_cla : update the tracer trend with the horizontal 12 !! and vertical advection trends at straits 13 !! tra_bab_el_mandeb : 14 !! tra_gibraltar : 15 !! tra_hormuz : 16 !! tra_cla_init : 18 !! cla_div : update of horizontal divergence at cla straits 19 !! tra_cla : update of tracers at cla straits 20 !! cla_dynspg : update of after horizontal velocities at cla straits 21 !! cla_init : initialisation - control check 22 !! cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait 23 !! cla_gibraltar : cross land advection for Gibraltar strait 24 !! cla_hormuz : cross land advection for Hormuz strait 17 25 !!---------------------------------------------------------------------- 18 !! * Modules used19 USE oce ! ocean dynamics and tracers variables20 USE dom_oce ! ocean space and time domain variables21 USE sbc_oce ! surface boundary condition: ocean22 USE in_out_manager 23 USE l bclnk ! ocean lateral boundary conditions (or mpp link)24 USE l ib_mpp ! distributed memory computing26 USE oce ! ocean dynamics and tracers 27 USE dom_oce ! ocean space and time domain 28 USE sbc_oce ! surface boundary condition: ocean 29 USE dynspg_oce ! ocean dynamics: surface pressure gradient variables 30 USE in_out_manager ! I/O manager 31 USE lib_mpp ! distributed memory computing library 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 33 26 34 IMPLICIT NONE 27 35 PRIVATE 28 29 !! * Routine accessibility 30 PUBLIC tra_cla ! routine called by step.F90 31 PUBLIC tra_cla_init ! routine called by opa.F90 32 33 !! * Modules variables 34 REAL(wp) :: zempmed, zempred 35 36 REAL(wp) :: zisw_rs, zurw_rs, zbrw_rs ! Imposed transport Red Sea 37 REAL(wp) :: zisw_ms, zmrw_ms, zurw_ms, zbrw_ms ! Imposed transport Med Sea 38 REAL(wp) :: zisw_pg, zbrw_pg ! Imposed transport Persic Gulf 39 40 REAL(wp), DIMENSION(jpk) :: & 41 zu1_rs_i, zu2_rs_i, zu3_rs_i, & ! Red Sea velocities 42 zu1_ms_i, zu2_ms_i, zu3_ms_i, & ! Mediterranean Sea velocities 43 zu_pg ! Persic Gulf velocities 44 REAL(wp), DIMENSION (jpk) :: zthor, zshor ! Temperature, salinity Hormuz 36 37 PUBLIC cla_init ! routine called by opa.F90 38 PUBLIC cla_div ! routine called by divcur.F90 39 PUBLIC cla_traadv ! routine called by traadv.F90 40 PUBLIC cla_dynspg ! routine called by dynspg_flt.F90 41 42 INTEGER :: nbab, ngib, nhor ! presence or not of required grid-point on local domain 43 ! ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits 44 45 ! !!! profile of hdiv for some straits 46 REAL(wp), DIMENSION (jpk) :: hdiv_139_101, hdiv_139_101_kt ! Gibraltar strait, fixed & time evolving part (i,j)=(172,101) 47 REAL(wp), DIMENSION (jpk) :: hdiv_139_102 ! Gibraltar strait, fixed part only (i,j)=(139,102) 48 REAL(wp), DIMENSION (jpk) :: hdiv_141_102, hdiv_141_102_kt ! Gibraltar strait, fixed & time evolving part (i,j)=(141,102) 49 REAL(wp), DIMENSION (jpk) :: hdiv_161_88 , hdiv_161_88_kt ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88) 50 REAL(wp), DIMENSION (jpk) :: hdiv_161_87 ! Bab-el-Mandeb strait, fixed part only (i,j)=(161,87) 51 REAL(wp), DIMENSION (jpk) :: hdiv_160_89 , hdiv_160_89_kt ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89) 52 REAL(wp), DIMENSION (jpk) :: hdiv_172_94 ! Hormuz strait, fixed part only (i,j)=(172, 94) 53 54 REAL(wp), DIMENSION (jpk) :: t_171_94_hor, s_171_94_hor ! Temperature, salinity in the Hormuz strait 45 55 46 56 !! * Substitutions 47 57 # include "domzgr_substitute.h90" 48 # include "vectopt_loop_substitute.h90"49 58 !!---------------------------------------------------------------------- 50 59 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 51 60 !! $Id$ 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 62 !!---------------------------------------------------------------------- 54 55 63 CONTAINS 56 64 57 SUBROUTINE tra_cla( kt ) 65 SUBROUTINE cla_div( kt ) 66 !!---------------------------------------------------------------------- 67 !! *** ROUTINE div_cla *** 68 !! 69 !! ** Purpose : update the horizontal divergence of the velocity field 70 !! at some straits ( Gibraltar, Bab el Mandeb and Hormuz ). 71 !! 72 !! ** Method : - first time-step: initialisation of cla 73 !! - all time-step: using imposed transport at each strait, 74 !! the now horizontal divergence is updated 75 !! 76 !! ** Action : phdivn updted now horizontal divergence at cla straits 77 !!---------------------------------------------------------------------- 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index 79 !!---------------------------------------------------------------------- 80 ! 81 IF( kt == nit000 ) THEN 82 ! 83 CALL cla_init ! control check 84 ! 85 IF(lwp) WRITE(numout,*) 86 IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv ' 87 IF(lwp) WRITE(numout,*) '~~~~~~~~' 88 ! 89 IF( nbab == 1 ) CALL cla_bab_el_mandeb('ini') ! Bab el Mandeb ( Red Sea - Indian ocean ) 90 IF( ngib == 1 ) CALL cla_gibraltar ('ini') ! Gibraltar strait (Med Sea - Atlantic ocean) 91 IF( nhor == 1 ) CALL cla_hormuz ('ini') ! Hormuz Strait ( Persian Gulf - Indian ocean ) 92 ! 93 ENDIF 94 ! 95 IF( nbab == 1 ) CALL cla_bab_el_mandeb('div') ! Bab el Mandeb ( Red Sea - Indian ocean ) 96 IF( ngib == 1 ) CALL cla_gibraltar ('div') ! Gibraltar strait (Med Sea - Atlantic ocean) 97 IF( nhor == 1 ) CALL cla_hormuz ('div') ! Hormuz Strait ( Persian Gulf - Indian ocean ) 98 ! 99 !!gm lbc useless here, no? 100 !!gm CALL lbc_lnk( hdivn, 'T', 1. ) ! Lateral boundary conditions on hdivn 101 ! 102 END SUBROUTINE cla_div 103 104 105 SUBROUTINE cla_traadv( kt ) 58 106 !!---------------------------------------------------------------------- 59 107 !! *** ROUTINE tra_cla *** … … 63 111 !! at some straits ( Bab el Mandeb, Gibraltar, Hormuz ). 64 112 !! 65 !! ** Method : ... 66 !! Add this trend now to the general trend of tracer (ta,sa): 67 !! (ta,sa) = (ta,sa) + ( zta , zsa ) 68 !! 69 !! ** Action : update (ta,sa) with the now advective tracer trends 70 !! 71 !! History : 72 !! ! (A. Bozec) original code 73 !! 8.5 ! 02-11 (A. Bozec) F90: Free form and module 74 !!---------------------------------------------------------------------- 75 !! * Arguments 113 !! ** Method : using both imposed transport at each strait and T & S 114 !! budget, the now tracer trends is updated 115 !! 116 !! ** Action : (ta,sa) updated now tracer trends at cla straits 117 !!---------------------------------------------------------------------- 76 118 INTEGER, INTENT( in ) :: kt ! ocean time-step index 77 119 !!---------------------------------------------------------------------- 78 79 ! Bab el Mandeb strait horizontal advection 80 81 CALL tra_bab_el_mandeb 82 83 ! Gibraltar strait horizontal advection 84 85 CALL tra_gibraltar 86 87 ! Hormuz Strait ( persian Gulf) horizontal advection 88 89 CALL tra_hormuz 90 91 END SUBROUTINE tra_cla 92 93 94 SUBROUTINE tra_bab_el_mandeb 120 ! 121 IF( kt == nit000 ) THEN 122 IF(lwp) WRITE(numout,*) 123 IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers ' 124 IF(lwp) WRITE(numout,*) '~~~~~~~~' 125 ENDIF 126 ! 127 IF( nbab == 1 ) CALL cla_bab_el_mandeb('tra') ! Bab el Mandeb strait 128 IF( ngib == 1 ) CALL cla_gibraltar ('tra') ! Gibraltar strait 129 IF( nhor == 1 ) CALL cla_hormuz ('tra') ! Hormuz Strait ( Persian Gulf) 130 ! 131 END SUBROUTINE cla_traadv 132 133 134 SUBROUTINE cla_dynspg( kt ) 135 !!---------------------------------------------------------------------- 136 !! *** ROUTINE cla_dynspg *** 137 !! 138 !! ** Purpose : Update the after velocity at some straits 139 !! (Bab el Mandeb, Gibraltar, Hormuz). 140 !! 141 !! ** Method : required to compute the filtered surface pressure gradient 142 !! 143 !! ** Action : (ua,va) after velocity at the cla straits 144 !!---------------------------------------------------------------------- 145 INTEGER, INTENT( in ) :: kt ! ocean time-step index 146 !!---------------------------------------------------------------------- 147 ! 148 IF( kt == nit000 ) THEN 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) ' 151 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 152 ENDIF 153 ! 154 IF( nbab == 1 ) CALL cla_bab_el_mandeb('spg') ! Bab el Mandeb strait 155 IF( ngib == 1 ) CALL cla_gibraltar ('spg') ! Gibraltar strait 156 IF( nhor == 1 ) CALL cla_hormuz ('spg') ! Hormuz Strait ( Persian Gulf) 157 ! 158 !!gm lbc is needed here, not? 159 !!gm CALL lbc_lnk( hdivn, 'U', -1. ) ; CALL lbc_lnk( hdivn, 'V', -1. ) ! Lateral boundary conditions 160 ! 161 END SUBROUTINE cla_dynspg 162 163 164 SUBROUTINE cla_init 165 !! ------------------------------------------------------------------- 166 !! *** ROUTINE cla_init *** 167 !! 168 !! ** Purpose : control check for mpp computation 169 !! 170 !! ** Method : - All the strait grid-points must be inside one of the 171 !! local domain interior for the cla advection to work 172 !! properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ). 173 !! Define the corresponding indicators (nbab, ngib, nhor) 174 !! - The profiles of cross-land fluxes are currently hard 175 !! coded for L31 levels. Stop if jpk/=31 176 !! 177 !! ** Action : nbab, ngib, nhor strait inside the local domain or not 95 178 !!--------------------------------------------------------------------- 96 !! *** ROUTINE tra_bab_el_mandeb *** 97 !! 98 !! ** Purpose : Update the horizontal advective trend of tracers 99 !! correction in Bab el Mandeb strait and 100 !! add it to the general trend of tracer equations. 179 REAL(wp) :: ztemp 180 !!--------------------------------------------------------------------- 181 ! 182 IF(lwp) WRITE(numout,*) 183 IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation ' 184 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 185 ! 186 IF( .NOT.lk_dynspg_flt ) CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' ) 187 ! 188 IF( lk_vvl ) CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' ) 189 ! 190 IF( jpk /= 31 ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 191 ! 192 ! _|_______|_______|_ 193 ! 89 | |///////| 194 ! _|_______|_______|_ 195 ! ------------------------ ! 88 |///////| | 196 ! Bab el Mandeb strait ! _|_______|_______|_ 197 ! ------------------------ ! 87 |///////| | 198 ! _|_______|_______|_ 199 ! | 160 | 161 | 200 ! 201 ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the 202 ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 203 nbab = 0 204 IF( ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND. & !* (161,89), (161,88) and (161,88) on the local pocessor 205 & ( 1 <= mi0(160) .AND. mi1(161) <= jpi ) ) nbab = 1 206 ! 207 ! test if there is no local domain that includes all required grid-points 208 ztemp = REAL( nbab ) 209 IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value 210 IF( ztemp == 0 ) THEN ! Only 2 points in each direction, this should never be a problem 211 CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' ) 212 ENDIF 213 ! ___________________________ 214 ! ------------------------ ! 102 | |///////| | 215 ! Gibraltar strait ! _|_______|_______|_______|_ 216 ! ------------------------ ! 101 | |///////| | 217 ! _|_______|_______|_______|_ 218 ! | 139 | 140 | 141 | 219 ! 220 ! The 6 Gibraltar grid-points must be inside one of the interior of the 221 ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 222 ngib = 0 223 IF( ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND. & !* (139:141,101:102) on the local pocessor 224 & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 ) ) ngib = 1 225 ! 226 ! test if there is no local domain that includes all required grid-points 227 ztemp = REAL( ngib ) 228 IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value 229 IF( ztemp == 0 ) THEN ! 3 points in i-direction, this may be a problem with some cutting 230 CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' ) 231 ENDIF 232 ! _______________ 233 ! ------------------------ ! 94 |/////| | 234 ! Hormuz strait ! _|_____|_____|_ 235 ! ------------------------ ! 171 172 236 ! 237 ! The 2 Hormuz grid-points must be inside one of the interior of the 238 ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 239 nhor = 0 240 IF( 2 <= mj0( 94) .AND. mj1( 94) <= jpjm1 .AND. & 241 & 2 <= mi0(171) .AND. mi1(172) <= jpim1 ) nhor = 1 242 ! 243 ! test if there is no local domain that includes all required grid-points 244 ztemp = REAL( nhor ) 245 IF( lk_mpp ) CALL mpp_sum( ztemp ) ! sum with other processors value 246 IF( ztemp == 0 ) THEN ! 3 points in i-direction, this may be a problem with some cutting 247 CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' ) 248 ENDIF 249 ! 250 END SUBROUTINE cla_init 251 252 253 SUBROUTINE cla_bab_el_mandeb( cd_td ) 254 !!---------------------------------------------------------------------- 255 !! *** ROUTINE cla_bab_el_mandeb *** 256 !! 257 !! ** Purpose : update the now horizontal divergence, the tracer tendancy 258 !! and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean). 259 !! 260 !! ** Method : compute the exchanges at each side of the strait : 261 !! 262 !! surf. zio_flow 263 !! (+ balance of emp) /\ |\\\\\\\\\\\| 264 !! || |\\\\\\\\\\\| 265 !! deep zio_flow || |\\\\\\\\\\\| 266 !! | || || |\\\\\\\\\\\| 267 !! 89 | || || |\\\\\\\\\\\| 268 !! |__\/_v_||__|____________ 269 !! !\\\\\\\\\\\| surf. zio_flow 270 !! |\\\\\\\\\\\|<=== (+ balance of emp) 271 !! |\\\\\\\\\\\u 272 !! 88 |\\\\\\\\\\\|<--- deep zrecirc (upper+deep at 2 different levels) 273 !! |___________|__________ 274 !! !\\\\\\\\\\\| 275 !! |\\\\\\\\\\\| ---\ deep zrecirc (upper+deep) 276 !! 87 !\\\\\\\\\\\u ===/ + deep zio_flow (all at the same level) 277 !! !\\\\\\\\\\\| 278 !! !___________|__________ 279 !! 160 161 280 !! 281 !!---------------------------------------------------------------------- 282 CHARACTER(len=1), INTENT(in) :: cd_td ! ='div' update the divergence 283 ! ! ='tra' update the tracers 284 ! ! ='spg' update after velocity 285 INTEGER :: ji, jj, jk ! dummy loop indices 286 REAL(wp) :: zemp_red ! temporary scalar 287 REAL(wp) :: zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot 288 !!--------------------------------------------------------------------- 289 ! 290 SELECT CASE( cd_td ) 291 ! ! ---------------- ! 292 CASE( 'ini' ) ! initialisation ! 293 ! ! ---------------- ! 294 ! 295 zio_flow = 0.4e6 ! imposed in/out flow 296 zrecirc_upp = 0.2e6 ! imposed upper recirculation water 297 zrecirc_bot = 0.5e6 ! imposed bottom recirculation water 298 299 hdiv_161_88(:) = 0.e0 ! (161,88) Gulf of Aden side, north point 300 hdiv_161_87(:) = 0.e0 ! (161,87) Gulf of Aden side, south point 301 hdiv_160_89(:) = 0.e0 ! (160,89) Red sea side 302 303 DO jj = mj0(88), mj1(88) !** profile of hdiv at (161,88) (Gulf of Aden side, north point) 304 DO ji = mi0(161), mi1(161) !------------------------------ 305 DO jk = 1, 8 ! surface in/out flow (Ind -> Red) (div >0) 306 hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 307 END DO 308 ! ! recirculation water (Ind -> Red) (div >0) 309 hdiv_161_88(20) = + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) ) 310 hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 311 END DO 312 END DO 313 ! 314 DO jj = mj0(87), mj1(87) !** profile of hdiv at (161,88) (Gulf of Aden side, south point) 315 DO ji = mi0(161), mi1(161) !------------------------------ 316 ! ! deep out flow + recirculation (Red -> Ind) (div <0) 317 hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 318 END DO 319 END DO 320 ! 321 DO jj = mj0(89), mj1(89) !** profile of hdiv at (161,88) (Red sea side) 322 DO ji = mi0(160), mi1(160) !------------------------------ 323 DO jk = 1, 8 ! surface inflow (Ind -> Red) (div <0) 324 hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 325 END DO 326 ! ! deep outflow (Red -> Ind) (div >0) 327 hdiv_160_89(16) = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) ) 328 END DO 329 END DO 330 ! ! ---------------- ! 331 CASE( 'div' ) ! update hdivn ! (call by divcur module) 332 ! ! ---------=====-- ! 333 ! !** emp on the Red Sea (div >0) 334 zemp_red = 0.e0 !--------------------- 335 DO jj = mj0(87), mj1(96) ! sum over the Red sea 336 DO ji = mi0(148), mi1(160) 337 zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 338 END DO 339 END DO 340 IF( lk_mpp ) CALL mpp_sum( zemp_red ) ! sum with other processors value 341 zemp_red = zemp_red * 1.e-3 ! convert in m3 342 ! 343 ! !** Correct hdivn (including emp adjustment) 344 ! !------------------------------------------- 345 DO jj = mj0(88), mj1(88) !* profile of hdiv at (161,88) (Gulf of Aden side, north point) 346 DO ji = mi0(161), mi1(161) 347 hdiv_161_88_kt(:) = hdiv_161_88(:) 348 DO jk = 1, 8 ! increase the inflow from the Indian (div >0) 349 hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) ) 350 END DO 351 hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:) 352 END DO 353 END DO 354 DO jj = mj0(87), mj1(87) !* profile of divergence at (161,87) (Gulf of Aden side, south point) 355 DO ji = mi0(161), mi1(161) 356 hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:) 357 END DO 358 END DO 359 DO jj = mj0(89), mj1(89) !* profile of divergence at (160,89) (Red sea side) 360 DO ji = mi0(160), mi1(160) 361 hdiv_160_89_kt(:) = hdiv_160_89(:) 362 DO jk = 1, 18 ! increase the inflow from the Indian (div <0) 363 hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) ) 364 END DO 365 hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:) 366 END DO 367 END DO 368 ! ! ---------------- ! 369 CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module) 370 ! ! --------=======- ! 371 ! 372 DO jj = mj0(88), mj1(88) !** (161,88) (Gulf of Aden side, north point) 373 DO ji = mi0(161), mi1(161) 374 DO jk = 1, jpkm1 ! surf inflow + reciculation (from Gulf of Aden) 375 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk) 376 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk) 377 END DO 378 END DO 379 END DO 380 DO jj = mj0(87), mj1(87) !** (161,87) (Gulf of Aden side, south point) 381 DO ji = mi0(161), mi1(161) 382 jk = 21 ! deep outflow + recirulation (combined flux) 383 ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji ,jj+1,20) & ! upper recirculation from Gulf of Aden 384 & + hdiv_161_88(21) * tn(ji ,jj+1,21) & ! deep recirculation from Gulf of Aden 385 & + hdiv_160_89(16) * tn(ji-1,jj+2,16) ! deep inflow from Red sea 386 sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji ,jj+1,20) & 387 & + hdiv_161_88(21) * sn(ji ,jj+1,21) & 388 & + hdiv_160_89(16) * sn(ji-1,jj+2,16) 389 END DO 390 END DO 391 DO jj = mj0(89), mj1(89) !** (161,88) (Red sea side) 392 DO ji = mi0(160), mi1(160) 393 DO jk = 1, 14 ! surface inflow (from Gulf of Aden) 394 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk) 395 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk) 396 END DO 397 ! ! deep outflow (from Red sea) 398 ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk) 399 sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk) 400 END DO 401 END DO 402 ! 403 ! ! ---------------- ! 404 CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module) 405 ! ! --------=======- ! 406 ! at this stage, (ua,va) are the after velocity, not the tendancy 407 ! compute the velocity from the divergence at T-point 408 ! 409 DO jj = mj0(88), mj1(88) !** (160,88) (Gulf of Aden side, north point) 410 DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point) 411 ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 412 & * e2u(ji,jj) * fse3u(ji,jj,:) 413 END DO 414 END DO 415 DO jj = mj0(87), mj1(87) !** (160,87) (Gulf of Aden side, south point) 416 DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point) 417 ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 418 & * e2u(ji,jj) * fse3u(ji,jj,:) 419 END DO 420 END DO 421 DO jj = mj0(88), mj1(88) !** profile of divergence at (160,89) (Red sea side) 422 DO ji = mi0(160), mi1(160) ! 88, not 89 as it is a V-point) 423 va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) ) & 424 & * e1v(ji,jj) * fse3v(ji,jj,:) 425 END DO 426 END DO 427 END SELECT 428 ! 429 END SUBROUTINE cla_bab_el_mandeb 430 431 432 SUBROUTINE cla_gibraltar( cd_td ) 433 !! ------------------------------------------------------------------- 434 !! *** ROUTINE cla_gibraltar *** 435 !! 436 !! ** Purpose : update the now horizontal divergence, the tracer 437 !! tendancyand the after velocity in vicinity of Gibraltar 438 !! strait ( Persian Gulf - Indian ocean ). 101 439 !! 102 440 !! ** Method : 103 !! We impose transport at Bab el Mandeb and knowing T and S in 104 !! surface and depth at each side of the strait, we deduce T and S 105 !! of the deep outflow of the Red Sea in the Indian ocean . 106 !! | 107 !! |/ \| N |\ /| 108 !! |_|_|______ | |___|______ 109 !! 88 | |<- W - - E 88 | |<- 110 !! 87 |___|______ | 87 |___|->____ 111 !! 160 161 S 160 161 112 !! horizontal view horizontal view 113 !! surface depth 114 !! 115 !! The horizontal advection is evaluated by a second order cen- 116 !! tered scheme using now fields (leap-frog scheme). In specific 117 !! areas (vicinity of major river mouths, some straits, or tn 118 !! approaching the freezing point) it is mixed with an upstream 119 !! scheme for stability reasons. 120 !! 121 !! C A U T I O N : the trend saved is the centered trend only. 122 !! It doesn't take into account the upstream part of the scheme. 123 !! 124 !! ** history : 125 !! ! 02-11 (A. Bozec) Original code 126 !! 8.5 ! 02-11 (A. Bozec) F90: Free form and module 441 !! _______________________ 442 !! deep zio_flow /====|///////|====> surf. zio_flow 443 !! + deep zrecirc \----|///////| (+balance of emp) 444 !! 102 u///////u 445 !! mid. recicul <--|///////|<==== deep zio_flow 446 !! _____|_______|_____ 447 !! surf. zio_flow ====>|///////| 448 !! (+balance of emp) |///////| 449 !! 101 u///////| 450 !! mid. recicul -->|///////| Caution: zrecirc split into 451 !! deep zrecirc ---->|///////| upper & bottom recirculation 452 !! _______|_______|_______ 453 !! 139 140 141 454 !! 127 455 !!--------------------------------------------------------------------- 128 !! * Local declarations 129 INTEGER :: ji, jj, jk ! dummy loop indices 130 REAL(wp) :: zsu, zvt 131 REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4 132 REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4 133 REAL(wp) :: zt, zs 134 REAL(wp) :: zwei 135 REAL(wp), DIMENSION (jpk) :: zu1_rs, zu2_rs, zu3_rs 456 CHARACTER(len=1), INTENT(in) :: cd_td ! ='div' update the divergence 457 ! ! ='tra' update the tracers 458 ! ! ='spg' update after velocity 459 INTEGER :: ji, jj, jk ! dummy loop indices 460 REAL(wp) :: zemp_med ! temporary scalar 461 REAL(wp) :: zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot 136 462 !!--------------------------------------------------------------------- 137 138 ! Initialization of vertical sum for T and S transport 139 ! ---------------------------------------------------- 140 141 zsumt = 0.e0 ! East Bab el Mandeb surface north point (T) 142 zsums = 0.e0 ! East Bab el Mandeb surface north point (S) 143 zsumt1 = 0.e0 ! East Bab el Mandeb depth south point (T) 144 zsums1 = 0.e0 ! East Bab el Mandeb depth south point (S) 145 zsumt2 = 0.e0 ! West Bab el Mandeb surface (T) 146 zsums2 = 0.e0 ! West Bab el Mandeb surface (S) 147 zsumt3 = 0.e0 ! West Bab el Mandeb depth (T) 148 zsums3 = 0.e0 ! West Bab el Mandeb depth (S) 149 zsumt4 = 0.e0 ! East Bab el Mandeb depth north point (T) 150 zsums4 = 0.e0 ! East Bab el Mandeb depth north point (S) 151 152 ! EMP of the Red Sea 153 ! ------------------ 154 155 zempred = 0.e0 156 zwei = 0.e0 157 DO jj = mj0(87), mj1(96) 158 DO ji = mi0(148), mi1(160) 159 zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) 160 zempred = zempred + ( emp(ji,jj) - rnf(ji,jj) ) * zwei 161 END DO 162 END DO 163 IF( lk_mpp ) CALL mpp_sum( zempred ) ! sum with other processors value 164 165 ! convert in m3 166 zempred = zempred * 1.e-3 167 168 ! Velocity profile at each point 169 ! ------------------------------ 170 171 zu1_rs(:) = zu1_rs_i(:) 172 zu2_rs(:) = zu2_rs_i(:) 173 zu3_rs(:) = zu3_rs_i(:) 174 175 ! velocity profile at 161,88 East Bab el Mandeb North point 176 ! we imposed zisw_rs + EMP above the Red Sea 177 DO jk = 1, 8 178 DO jj = mj0(88), mj1(88) 179 DO ji = mi0(160), mi1(160) 180 zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 181 END DO 182 END DO 183 END DO 184 185 ! velocity profile at 161, 88 West Bab el Mandeb 186 ! we imposed zisw_rs + EMP above the Red Sea 187 DO jk = 1, 10 188 DO jj = mj0(88), mj1(88) 189 DO ji = mi0(160), mi1(160) 190 zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 191 END DO 192 END DO 193 END DO 194 195 ! Balance of temperature and salinity 196 ! ----------------------------------- 197 198 ! east Bab el Mandeb surface vertical sum of transport* S,T 199 DO jk = 1, 19 200 DO jj = mj0(88), mj1(88) 201 DO ji = mi0(161), mi1(161) 202 zsumt = zsumt + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 203 zsums = zsums + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 204 END DO 205 END DO 206 END DO 207 208 ! west Bab el Mandeb surface vertical sum of transport* S,T 209 DO jk = 1, 10 210 DO jj = mj0(88), mj1(88) 211 DO ji = mi0(161), mi1(161) 212 zsumt2 = zsumt2 + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) 213 zsums2 = zsums2 + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) 214 END DO 215 END DO 216 END DO 217 218 ! west Bab el Mandeb deeper 219 DO jj = mj0(89), mj1(89) 220 DO ji = mi0(160), mi1(160) 221 zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) 222 zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) 223 END DO 224 END DO 225 226 ! east Bab el Mandeb deeper 227 DO jk = 20, 21 228 DO jj = mj0(88), mj1(88) 229 DO ji = mi0(161), mi1(161) 230 zsumt4 = zsumt4 + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 231 zsums4 = zsums4 + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 232 END DO 233 END DO 234 END DO 235 236 ! Total transport 237 zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 ) 238 zsums1 = -( zsums3 + zsums2 + zsums + zsums4 ) 239 240 ! Temperature and Salinity at East Bab el Mandeb, Level 21 241 DO jj = mj0(88), mj1(88) 242 DO ji = mi0(160), mi1(160) 243 zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) 244 zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) 245 END DO 246 END DO 247 248 ! New Temperature and Salinity at East Bab el Mandeb 249 ! -------------------------------------------------- 250 251 ! north point 252 DO jk = 1, jpk 253 DO jj = mj0(88), mj1(88) 254 DO ji = mi0(161), mi1(161) 255 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 256 zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 257 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * tn(ji,jj,jk) 258 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * sn(ji,jj,jk) 259 END DO 260 END DO 261 END DO 262 263 ! south point 264 jk = 21 265 DO jj = mj0(87), mj1(87) 266 DO ji = mi0(161), mi1(161) 267 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 268 zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 269 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zt 270 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zs 271 END DO 272 END DO 273 274 275 ! New Temperature and Salinity at West Bab el Mandeb 276 ! -------------------------------------------------- 277 278 ! surface 279 DO jk = 1, 10 280 DO jj = mj0(89), mj1(89) 281 DO ji = mi0(160), mi1(160) 282 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 283 zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk) 284 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji+1,jj-1,jk) 285 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji+1,jj-1,jk) 286 END DO 287 END DO 288 END DO 289 ! deeper 290 jk = 16 291 DO jj = mj0(89), mj1(89) 292 DO ji = mi0(160), mi1(160) 293 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 294 zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk) 295 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji,jj,jk) 296 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji,jj,jk) 297 END DO 298 END DO 299 300 END SUBROUTINE tra_bab_el_mandeb 301 302 303 SUBROUTINE tra_gibraltar 463 ! 464 SELECT CASE( cd_td ) 465 ! ! ---------------- ! 466 CASE( 'ini' ) ! initialisation ! 467 ! ! ---------------- ! 468 ! !** initialization of the velocity 469 hdiv_139_101(:) = 0.e0 ! 139,101 (Atlantic side, south point) 470 hdiv_139_102(:) = 0.e0 ! 139,102 (Atlantic side, north point) 471 hdiv_141_102(:) = 0.e0 ! 141,102 (Med sea side) 472 473 ! !** imposed transport 474 zio_flow = 0.8e6 ! inflow surface water 475 zrecirc_mid = 0.7e6 ! middle recirculation water 476 zrecirc_upp = 2.5e6 ! upper recirculation water 477 zrecirc_bot = 3.5e6 ! bottom recirculation water 478 ! 479 DO jj = mj0(101), mj1(101) !** profile of hdiv at 139,101 (Atlantic side, south point) 480 DO ji = mi0(139), mi1(139) !----------------------------- 481 DO jk = 1, 14 ! surface in/out flow (Atl -> Med) (div >0) 482 hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 483 END DO 484 DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div >0) 485 hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 486 END DO 487 ! ! upper reciculation (Atl 101 -> Atl 101) (div >0) 488 hdiv_139_101(21) = + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 489 ! 490 ! ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102) (div >0) 491 hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 492 END DO 493 END DO 494 DO jj = mj0(102), mj1(102) !** profile of hdiv at 139,102 (Atlantic side, north point) 495 DO ji = mi0(139), mi1(139) !----------------------------- 496 DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div <0) 497 hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 498 END DO 499 ! ! outflow of Mediterranean sea + deep recirculation (div <0) 500 hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 501 END DO 502 END DO 503 DO jj = mj0(102), mj1(102) !** velocity profile at 141,102 (Med sea side) 504 DO ji = mi0(141), mi1(141) !------------------------------ 505 DO jk = 1, 14 ! surface inflow in the Med (div <0) 506 hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 507 END DO 508 ! ! deep outflow toward the Atlantic (div >0) 509 hdiv_141_102(21) = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 510 END DO 511 END DO 512 ! ! ---------------- ! 513 CASE( 'div' ) ! update hdivn ! (call by divcur module) 514 ! ! ---------=====-- ! 515 ! !** emp on the Mediterranean Sea (div >0) 516 zemp_med = 0.e0 !------------------------------- 517 DO jj = mj0(96), mj1(110) ! sum over the Med sea 518 DO ji = mi0(141),mi1(181) 519 zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 520 END DO 521 END DO 522 DO jj = mj0(96), mj1(96) ! minus 2 points in Red Sea 523 DO ji = mi0(148),mi1(148) 524 zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 525 END DO 526 DO ji = mi0(149),mi1(149) 527 zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 528 END DO 529 END DO 530 IF( lk_mpp ) CALL mpp_sum( zemp_med ) ! sum with other processors value 531 zemp_med = zemp_med * 1.e-3 ! convert in m3 532 ! 533 ! !** Correct hdivn (including emp adjustment) 534 ! !------------------------------------------- 535 DO jj = mj0(101), mj1(101) !* 139,101 (Atlantic side, south point) 536 DO ji = mi0(139), mi1(139) 537 hdiv_139_101_kt(:) = hdiv_139_101(:) 538 DO jk = 1, 14 ! increase the inflow from the Atlantic (div >0) 539 hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 540 END DO 541 hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:) 542 END DO 543 END DO 544 DO jj = mj0(102), mj1(102) !* 139,102 (Atlantic side, north point) 545 DO ji = mi0(139), mi1(139) 546 hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:) 547 END DO 548 END DO 549 DO jj = mj0(102), mj1(102) !* 141,102 (Med side) 550 DO ji = mi0(141), mi1(141) 551 hdiv_141_102(:) = hdiv_141_102(:) 552 DO jk = 1, 14 ! increase the inflow from the Atlantic (div <0) 553 hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 554 END DO 555 hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:) 556 END DO 557 END DO 558 ! ! ---------------- ! 559 CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module) 560 ! ! --------=======- ! 561 ! 562 DO jj = mj0(101), mj1(101) !** 139,101 (Atlantic side, south point) (div >0) 563 DO ji = mi0(139), mi1(139) 564 DO jk = 1, jpkm1 ! surf inflow + mid. & bottom reciculation (from Atlantic) 565 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk) 566 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk) 567 END DO 568 END DO 569 END DO 570 ! 571 DO jj = mj0(102), mj1(102) !** 139,102 (Atlantic side, north point) (div <0) 572 DO ji = mi0(139), mi1(139) 573 DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div <0) 574 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk) ! middle Atlantic recirculation 575 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk) 576 END DO 577 ! ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0) 578 ! ! deep Med flow (Med 102 -> Atl 102) - (div <0) 579 ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj ,21) & ! deep Med flow 580 & + hdiv_139_101(21) * tn(ji ,jj-1,21) & ! upper Atlantic recirculation 581 & + hdiv_139_101(22) * tn(ji ,jj-1,22) ! bottom Atlantic recirculation 582 sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj ,21) & 583 & + hdiv_139_101(21) * sn(ji ,jj-1,21) & 584 & + hdiv_139_101(22) * sn(ji ,jj-1,22) 585 END DO 586 END DO 587 DO jj = mj0(102), mj1(102) !* 141,102 (Med side) (div <0) 588 DO ji = mi0(141), mi1(141) 589 DO jk = 1, 14 ! surface flow from Atlantic to Med sea 590 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk) 591 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk) 592 END DO 593 ! ! deeper flow from Med sea to Atlantic 594 ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21) 595 sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21) 596 END DO 597 END DO 598 ! ! ---------------- ! 599 CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module) 600 ! ! --------=======- ! 601 ! at this stage, (ua,va) are the after velocity, not the tendancy 602 ! compute the velocity from the divergence at T-point 603 ! 604 DO jj = mj0(101), mj1(101) !** 139,101 (Atlantic side, south point) 605 DO ji = mi0(139), mi1(139) ! div >0 => ua >0, same sign 606 ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) & 607 & * e2u(ji,jj) * fse3u(ji,jj,:) 608 END DO 609 END DO 610 DO jj = mj0(102), mj1(102) !** 139,102 (Atlantic side, north point) 611 DO ji = mi0(139), mi1(139) ! div <0 => ua <0, same sign 612 ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) & 613 & * e2u(ji,jj) * fse3u(ji,jj,:) 614 END DO 615 END DO 616 DO jj = mj0(102), mj1(102) !** 140,102 (Med side) (140 not 141 as it is a U-point) 617 DO ji = mi0(140), mi1(140) ! div >0 => ua <0, opposite sign 618 ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 619 & * e2u(ji,jj) * fse3u(ji,jj,:) 620 END DO 621 END DO 622 ! 623 END SELECT 624 ! 625 END SUBROUTINE cla_gibraltar 626 627 628 SUBROUTINE cla_hormuz( cd_td ) 629 !! ------------------------------------------------------------------- 630 !! *** ROUTINE div_hormuz *** 631 !! 632 !! ** Purpose : update the now horizontal divergence, the tracer 633 !! tendancyand the after velocity in vicinity of Hormuz 634 !! strait ( Persian Gulf - Indian ocean ). 635 !! 636 !! ** Method : Hormuz strait 637 !! ______________ 638 !! |/////|<== surface inflow 639 !! 94 |/////| 640 !! |/////|==> deep outflow 641 !! |_____|_______ 642 !! 171 172 304 643 !!--------------------------------------------------------------------- 305 !! *** ROUTINE tra_gibraltar *** 306 !! 307 !! ** Purpose : 308 !! Update the horizontal advective trend of tracers (t & s) 309 !! correction in Gibraltar and 310 !! add it to the general trend of tracer equations. 311 !! 312 !! ** Method : 313 !! We impose transport at Gibraltar and knowing T and S in 314 !! surface and deeper at each side of the strait, we deduce T and S 315 !! of the outflow of the Mediterranean Sea in the Atlantic ocean . 316 !! 317 !! ________________ N ________________ 318 !! 102 | |-> | <-| |<- 319 !! 101 ___->|____|_____ W - - E ___->|____|_____ 320 !! 139 140 141 | 139 140 141 321 !! horizontal view S horizontal view 322 !! surface depth 323 !! C A U T I O N : the trend saved is the centered trend only. 324 !! It doesn't take into account the upstream part of the scheme. 325 !! 326 !! ** history : 327 !! ! 02-06 (A. Bozec) Original code 328 !! 8.5 ! 02-11 (A. Bozec) F90: Free form and module 644 CHARACTER(len=1), INTENT(in) :: cd_td ! ='ini' initialisation 645 !! ! ='div' update the divergence 646 !! ! ='tra' update the tracers 647 !! ! ='spg' update after velocity 648 !! 649 INTEGER :: ji, jj, jk ! dummy loop indices 650 REAL(wp) :: zio_flow ! temporary scalar 329 651 !!--------------------------------------------------------------------- 330 !! * Local declarations 331 INTEGER :: ji, jj, jk ! dummy loop indices 332 REAL(wp) :: zsu, zvt 333 REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4 334 REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4 335 REAL(wp) :: zt, zs 336 REAL(wp) :: zwei 337 REAL(wp), DIMENSION (jpk) :: zu1_ms, zu2_ms, zu3_ms 338 !!--------------------------------------------------------------------- 339 340 ! Initialization of vertical sum for T and S transport 341 ! ---------------------------------------------------- 342 343 zsumt = 0.e0 ! West Gib. surface south point ( T ) 344 zsums = 0.e0 ! West Gib. surface south point ( S ) 345 zsumt1 = 0.e0 ! East Gib. surface north point ( T ) 346 zsums1 = 0.e0 ! East Gib. surface north point ( S ) 347 zsumt2 = 0.e0 ! East Gib. depth north point ( T ) 348 zsums2 = 0.e0 ! East Gib. depth north point ( S ) 349 zsumt3 = 0.e0 ! West Gib. depth south point ( T ) 350 zsums3 = 0.e0 ! West Gib. depth south point ( S ) 351 zsumt4 = 0.e0 ! West Gib. depth north point ( T ) 352 zsums4 = 0.e0 ! West Gib. depth north point ( S ) 353 354 ! EMP of Mediterranean Sea 355 ! ------------------------ 356 357 zempmed = 0.e0 358 zwei = 0.e0 359 DO jj = mj0(96),mj1(110) 360 DO ji = mi0(141),mi1(181) 361 zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) 362 zempmed = zempmed + ( emp(ji,jj) - rnf(ji,jj) ) * zwei 363 END DO 364 END DO 365 IF( lk_mpp ) CALL mpp_sum( zempmed ) ! sum with other processors value 366 367 368 ! minus 2 points in Red Sea and 3 in Atlantic ocean 369 DO jj = mj0(96),mj1(96) 370 DO ji = mi0(148),mi1(148) 371 zempmed = zempmed - ( emp(ji ,jj)-rnf(ji ,jj) ) * tmask(ji ,jj,1) * e1t(ji ,jj) * e2t(ji ,jj) & 372 - ( emp(ji+1,jj)-rnf(ji+1,jj) ) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj) 373 END DO 374 END DO 375 376 ! convert in m3 377 zempmed = zempmed * 1.e-3 378 379 ! Velocity profile at each point 380 ! ------------------------------ 381 382 zu1_ms(:) = zu1_ms_i(:) 383 zu2_ms(:) = zu2_ms_i(:) 384 zu3_ms(:) = zu3_ms_i(:) 385 386 ! velocity profile at 139,101 South point + (emp-rnf) on surface 387 DO jk = 1, 14 388 DO jj = mj0(102), mj1(102) 389 DO ji = mi0(140), mi1(140) 390 zu1_ms(jk) = zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 391 END DO 392 END DO 393 END DO 394 395 ! profile at East Gibraltar 396 ! velocity profile at 141,102 + (emp-rnf) on surface 397 DO jk = 1, 14 398 DO jj = mj0(102), mj1(102) 399 DO ji = mi0(140), mi1(140) 400 zu3_ms(jk) = zu3_ms(jk) + ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 401 END DO 402 END DO 403 END DO 404 405 ! Balance of temperature and salinity 406 ! ----------------------------------- 407 408 ! west gibraltar surface vertical sum of transport* S,T 409 DO jk = 1, 14 410 DO jj = mj0(101), mj1(101) 411 DO ji = mi0(139), mi1(139) 412 zsumt = zsumt + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 413 zsums = zsums + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 414 END DO 415 END DO 416 END DO 417 418 ! east Gibraltar surface vertical sum of transport* S,T 419 DO jk = 1, 14 420 DO jj = mj0(101), mj1(101) 421 DO ji = mi0(139), mi1(139) 422 zsumt1 = zsumt1 + tn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk) 423 zsums1 = zsums1 + sn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk) 424 END DO 425 END DO 426 END DO 427 428 ! east Gibraltar deeper vertical sum of transport* S,T 429 DO jj = mj0(102), mj1(102) 430 DO ji = mi0(141), mi1(141) 431 zsumt2 = tn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21) 432 zsums2 = sn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21) 433 END DO 434 END DO 435 436 ! west Gibraltar deeper vertical sum of transport* S,T 437 DO jk = 21, 22 438 DO jj = mj0(101), mj1(101) 439 DO ji = mi0(139), mi1(139) 440 zsumt3 = zsumt3 + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 441 zsums3 = zsums3 + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 442 END DO 443 END DO 444 END DO 445 446 ! Total transport = 0. 447 zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3 448 zsums4 = zsums2 + zsums1 - zsums - zsums3 449 450 ! Temperature and Salinity at West gibraltar , Level 22 451 DO jj = mj0(102), mj1(102) 452 DO ji = mi0(140), mi1(140) 453 zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) ) 454 zs = zsums4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) ) 455 END DO 456 END DO 457 458 ! New Temperature and Salinity trend at West Gibraltar 459 ! ---------------------------------------------------- 460 461 ! south point 462 DO jk = 1, 22 463 DO jj = mj0(101), mj1(101) 464 DO ji = mi0(139), mi1(139) 465 zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 466 zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 467 ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * tn(ji, jj,jk) 468 sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * sn(ji, jj,jk) 469 END DO 470 END DO 471 END DO 472 473 ! north point 474 DO jk = 15, 20 475 DO jj = mj0(102), mj1(102) 476 DO ji = mi0(139), mi1(139) 477 zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 478 zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 479 ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * tn(ji, jj-1,jk) 480 sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * sn(ji, jj-1,jk) 481 END DO 482 END DO 483 END DO 484 485 ! Gibraltar outflow, north point deeper 486 jk = 22 487 DO jj = mj0(102), mj1(102) 488 DO ji = mi0(139), mi1(139) 489 zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 490 zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 491 ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zt 492 sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zs 493 END DO 494 END DO 495 496 497 ! New Temperature and Salinity at East Gibraltar 498 ! ---------------------------------------------- 499 500 ! surface 501 DO jk = 1, 14 502 DO jj = mj0(102), mj1(102) 503 DO ji = mi0(141), mi1(141) 504 zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 505 zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk) 506 ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji-2, jj-1,jk) 507 sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji-2, jj-1,jk) 508 END DO 509 END DO 510 END DO 511 ! deeper 512 jk = 21 513 DO jj = mj0(102), mj1(102) 514 DO ji = mi0(141), mi1(141) 515 zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 516 zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk) 517 ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji, jj,jk) 518 sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji, jj,jk) 519 END DO 520 END DO 521 522 END SUBROUTINE tra_gibraltar 523 524 525 SUBROUTINE tra_hormuz 526 !!--------------------------------------------------------------------- 527 !! *** ROUTINE tra_hormuz *** 528 !! 529 !! ** Purpose : Update the horizontal advective trend of tracers 530 !! correction in Hormuz. 531 !! 532 !! ** Method : We impose transport at Hormuz . 533 !! 534 !! ** history : 535 !! ! 02-11 (A. Bozec) Original code 536 !! 8.5 ! 02-11 (A. Bozec) F90: Free form and module 537 !!--------------------------------------------------------------------- 538 !! * Local declarations 539 INTEGER :: ji, jj, jk ! dummy loop indices 540 REAL(wp) :: zsu, zvt 541 !!--------------------------------------------------------------------- 542 543 ! New trend at Hormuz strait 544 ! -------------------------- 545 DO jk = 1, 8 546 DO jj = mj0(94), mj1(94) 652 ! 653 SELECT CASE( cd_td ) 654 ! ! ---------------- ! 655 CASE( 'ini' ) ! initialisation ! 656 ! ! ---------------- ! 657 ! !** profile of horizontal divergence due to cross-land advection 658 zio_flow = 1.e6 ! imposed in/out flow 659 ! 660 hdiv_172_94(:) = 0.e0 661 ! 662 DO jj = mj0(94), mj1(94) ! in/out flow at (i,j) = (172,94) 547 663 DO ji = mi0(172), mi1(172) 548 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 549 zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 550 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * tn(ji,jj,jk) 551 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * sn(ji,jj,jk) 552 END DO 553 END DO 554 END DO 555 DO jk = 16, 18 556 DO jj = mj0(94), mj1(94) 664 DO jk = 1, 8 ! surface inflow (Indian ocean to Persian Gulf) (div<0) 665 hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 666 END DO 667 DO jk = 16, 18 ! deep outflow (Persian Gulf to Indian ocean) (div>0) 668 hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 669 END DO 670 END DO 671 END DO 672 ! !** T & S profile in the Hormuz strait (use in deep outflow) 673 ! Temperature and Salinity 674 t_171_94_hor(:) = 0.e0 ; s_171_94_hor(:) = 0.e0 675 t_171_94_hor(16) = 18.4 ; s_171_94_hor(16) = 36.27 676 t_171_94_hor(17) = 17.8 ; s_171_94_hor(17) = 36.4 677 t_171_94_hor(18) = 16. ; s_171_94_hor(18) = 36.27 678 ! 679 ! ! ---------------- ! 680 CASE( 'div' ) ! update hdivn ! (call by divcur module) 681 ! ! ---------=====-- ! 682 ! 683 DO jj = mj0(94), mj1(94) !** 172,94 (Indian ocean side) 557 684 DO ji = mi0(172), mi1(172) 558 zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 559 zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 560 ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zthor(jk) 561 sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zshor(jk) 562 END DO 563 END DO 564 END DO 565 566 END SUBROUTINE tra_hormuz 567 568 569 SUBROUTINE tra_cla_init 570 !!--------------------------------------------------------------------- 571 !! *** ROUTINE tra_cla_init *** 572 !! 573 !! ** Purpose : Initialization of variables 574 !! 575 !! ** history : 576 !! 9.0 ! 02-11 (A. Bozec) Original code 577 !!--------------------------------------------------------------------- 578 !! * Local declarations 579 INTEGER :: ji, jj, jk ! dummy loop indices 580 !!--------------------------------------------------------------------- 581 582 ! Control print 583 ! ------------- 584 585 IF(lwp) WRITE(numout,*) 586 IF(lwp) WRITE(numout,*) 'tra_cla_init : cross land advection on tracer ' 587 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 588 589 ! Initialization at Bab el Mandeb 590 ! ------------------------------- 591 592 ! imposed transport 593 zisw_rs = 0.4e6 ! inflow surface water 594 zurw_rs = 0.2e6 ! upper recirculation water 595 !!Alex zbrw_rs = 1.2e6 ! bottom recirculation water 596 zbrw_rs = 0.5e6 ! bottom recirculation water 597 598 ! initialization of the velocity at Bab el Mandeb 599 zu1_rs_i(:) = 0.e0 ! velocity profile at 161,88 South point 600 zu2_rs_i(:) = 0.e0 ! velocity profile at 161,87 North point 601 zu3_rs_i(:) = 0.e0 ! velocity profile at 160,88 East point 602 603 ! velocity profile at 161,88 East Bab el Mandeb North point 604 ! we imposed zisw_rs + EMP above the Red Sea 605 DO jk = 1, 8 606 DO jj = mj0(88), mj1(88) 607 DO ji = mi0(160), mi1(160) 608 zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) 609 END DO 610 END DO 611 END DO 612 613 ! recirculation water 614 DO jj = mj0(88), mj1(88) 615 DO ji = mi0(160), mi1(160) 616 zu1_rs_i(20) = -( zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,20) ) 617 zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) ) 618 END DO 619 END DO 620 621 ! velocity profile at 161,87 East Bab el Mandeb South point 622 DO jj = mj0(87), mj1(87) 623 DO ji = mi0(160), mi1(160) 624 zu2_rs_i(21) = ( zbrw_rs + zisw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) ) 625 END DO 626 END DO 627 628 ! velocity profile at 161, 88 West Bab el Mandeb 629 ! we imposed zisw_rs + EMP above the Red Sea 630 DO jk = 1, 10 631 DO jj = mj0(88), mj1(88) 632 DO ji = mi0(160), mi1(160) 633 zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 634 END DO 635 END DO 636 END DO 637 638 ! deeper 639 DO jj = mj0(88), mj1(88) 640 DO ji = mi0(160), mi1(160) 641 zu3_rs_i(16) = - zisw_rs /( e1v(ji,jj) * fse3v(ji,jj,16) ) 642 END DO 643 END DO 644 645 646 ! Initialization at Gibraltar 647 ! --------------------------- 648 649 ! imposed transport 650 zisw_ms = 0.8e6 ! atlantic-mediterranean water 651 zmrw_ms = 0.7e6 ! middle recirculation water 652 zurw_ms = 2.5e6 ! upper recirculation water 653 zbrw_ms = 3.5e6 ! bottom recirculation water 654 655 ! initialization of the velocity 656 zu1_ms_i(:) = 0.e0 ! velocity profile at 139,101 South point 657 zu2_ms_i(:) = 0.e0 ! velocity profile at 139,102 North point 658 zu3_ms_i(:) = 0.e0 ! velocity profile at 141,102 East point 659 660 ! velocity profile at 139,101 South point 661 DO jk = 1, 14 662 DO jj = mj0(102), mj1(102) 663 DO ji = mi0(140), mi1(140) 664 zu1_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk)) 665 END DO 666 END DO 667 END DO 668 669 ! middle recirculation ( uncounting in the balance ) 670 DO jk = 15, 20 671 DO jj = mj0(102), mj1(102) 672 DO ji = mi0(140), mi1(140) 673 zu1_ms_i(jk) = ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 674 END DO 675 END DO 676 END DO 677 678 DO jj = mj0(102), mj1(102) 679 DO ji = mi0(140), mi1(140) 680 zu1_ms_i(21) = ( zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) ) 681 zu1_ms_i(22) = ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) ) 682 END DO 683 END DO 684 685 ! velocity profile at 139,102 North point 686 ! middle recirculation ( uncounting in the balance ) 687 DO jk = 15, 20 688 DO jj = mj0(102), mj1(102) 689 DO ji = mi0(140), mi1(140) 690 zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 691 END DO 692 END DO 693 END DO 694 695 DO jj = mj0(102), mj1(102) 696 DO ji = mi0(140), mi1(140) 697 zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) ) 698 END DO 699 END DO 700 701 ! profile at East Gibraltar 702 ! velocity profile at 141,102 703 DO jk = 1, 14 704 DO jj = mj0(102), mj1(102) 705 DO ji = mi0(140), mi1(140) 706 zu3_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 707 END DO 708 END DO 709 END DO 710 711 ! deeper 712 DO jj = mj0(102), mj1(102) 713 DO ji = mi0(140), mi1(140) 714 zu3_ms_i(21) = -zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) ) 715 END DO 716 END DO 717 718 719 ! Initialization at Hormuz 720 ! ------------------------ 721 722 ! imposed transport 723 zisw_pg = 4. * 0.25e6 ! surface and bottom water 724 725 ! initialization of the velocity 726 zu_pg(:) = 0.e0 ! velocity profile at 139,101 South point 727 728 ! Velocity profile 729 DO jk = 1, 8 730 DO jj = mj0(94), mj1(94) 685 hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:) 686 END DO 687 END DO 688 ! ! ---------------- ! 689 CASE( 'tra' ) ! update (ta,sa) ! (call by traadv module) 690 ! ! --------=======- ! 691 ! 692 DO jj = mj0(94), mj1(94) !** 172,94 (Indian ocean side) 731 693 DO ji = mi0(172), mi1(172) 732 zu_pg(jk) = -( zisw_pg / 8. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk))733 END DO734 END DO735 END DO736 DO jk = 16, 18737 DO jj = mj0(94), mj1(94)738 DO ji = mi0(172), mi1(172)739 zu_pg(jk) = ( zisw_pg / 3. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )740 END DO 741 END DO 742 END DO743 744 ! Temperature and Salinity at Hormuz745 zthor(:) = 0.e0746 zshor(:) = 0.e0747 748 zthor(16) = 18.4749 zshor(16) = 36.27750 !751 zthor(17) = 17.8752 zshor(17) = 36.4753 !754 zthor(18) = 16.755 zshor(18) = 36.27756 757 END SUBROUTINE tra_cla_init758 694 DO jk = 1, 8 ! surface inflow (Indian ocean to Persian Gulf) (div<0) 695 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk) 696 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk) 697 END DO 698 DO jk = 16, 18 ! deep outflow (Persian Gulf to Indian ocean) (div>0) 699 ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk) 700 sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk) 701 END DO 702 END DO 703 END DO 704 ! ! ---------------- ! 705 CASE( 'spg' ) ! update (ua,va) ! (call by dynspg module) 706 ! ! --------=======- ! 707 ! No barotropic flow through Hormuz strait 708 ! at this stage, (ua,va) are the after velocity, not the tendancy 709 ! compute the velocity from the divergence at T-point 710 DO jj = mj0(94), mj1(94) !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point) 711 DO ji = mi0(171), mi1(171) ! div >0 => ua >0, opposite sign 712 ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 713 & * e2u(ji,jj) * fse3u(ji,jj,:) 714 END DO 715 END DO 716 ! 717 END SELECT 718 ! 719 END SUBROUTINE cla_hormuz 720 759 721 #else 760 722 !!---------------------------------------------------------------------- 761 !! Default option NO cross land advection723 !! Default key Dummy module 762 724 !!---------------------------------------------------------------------- 763 USE in_out_manager 725 USE in_out_manager ! I/O manager 764 726 CONTAINS 765 SUBROUTINE tra_cla_init 766 END SUBROUTINE tra_cla_init 767 SUBROUTINE tra_cla( kt ) 768 INTEGER, INTENT(in) :: kt ! ocean time-step indice 769 IF( kt == nit000 .AND. lwp ) THEN 770 WRITE(numout,*) 771 WRITE(numout,*) 'tra_cla : No use of cross land advection' 772 WRITE(numout,*) '~~~~~~~' 773 ENDIF 774 END SUBROUTINE tra_cla 727 SUBROUTINE cla_init 728 CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' ) 729 END SUBROUTINE cla_init 730 SUBROUTINE cla_div( kt ) 731 WRITE(*,*) 'cla_div: You should have not see this print! error?', kt 732 END SUBROUTINE cla_div 733 SUBROUTINE cla_traadv( kt ) 734 WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt 735 END SUBROUTINE cla_traadv 736 SUBROUTINE cla_dynspg( kt ) 737 WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt 738 END SUBROUTINE cla_dynspg 775 739 #endif 776 740 777 741 !!====================================================================== 778 742 END MODULE cla -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90
r2382 r2392 38 38 USE step_oce ! module used in the ocean time stepping module 39 39 USE sbc_oce ! surface boundary condition: ocean 40 USE cla ! cross land advection (tra_cla routine) 40 41 USE domcfg ! domain configuration (dom_cfg routine) 41 42 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 46 47 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 47 48 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 48 USE zdfini 49 USE zdfini ! vertical physics setting (zdf_init routine) 49 50 USE phycst ! physical constant (par_cst routine) 50 51 USE trdmod ! momentum/tracers trends (trd_mod_init routine) … … 67 68 USE trcini ! passive tracer initialisation 68 69 #endif 69 70 70 USE lib_mpp ! distributed memory computing 71 71 #if defined key_iomput … … 82 82 !!---------------------------------------------------------------------- 83 83 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 84 !! $Id 84 !! $Id$ 85 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 86 86 !!---------------------------------------------------------------------- … … 277 277 CALL ldf_tra_init ! Lateral ocean tracer physics 278 278 CALL ldf_dyn_init ! Lateral ocean momentum physics 279 IF( lk_ldfslp )CALL ldf_slp_init ! slope of lateral mixing279 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 280 280 281 281 ! ! Active tracers … … 285 285 IF( lk_tradmp ) CALL tra_dmp_init ! internal damping trends 286 286 CALL tra_adv_init ! horizontal & vertical advection 287 IF( n_cla == 1 ) CALL tra_cla_init ! Cross Land Advection (Update Hor. advection)288 287 CALL tra_ldf_init ! lateral mixing 289 288 CALL tra_zdf_init ! vertical mixing and after tracer fields … … 296 295 CALL dyn_zdf_init ! vertical diffusion 297 296 CALL dyn_spg_init ! surface pressure gradient 297 298 ! ! Misc. options 299 IF( nn_cla == 1 ) CALL cla_init ! Cross Land Advection 300 298 301 #if defined key_top 299 302 ! ! Passive tracers … … 302 305 ! ! Diagnostics 303 306 CALL iom_init ! iom_put initialization 304 IF( lk_floats )CALL flo_init ! drifting Floats305 IF( lk_diaar5 )CALL dia_ar5_init ! ar5 diag307 IF( lk_floats ) CALL flo_init ! drifting Floats 308 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag 306 309 CALL dia_ptr_init ! Poleward TRansports initialization 307 310 CALL dia_hsb_init ! heat content, salt content and volume budgets 308 311 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 309 IF( lk_diaobs ) THEN! Observation & model comparison312 IF( lk_diaobs ) THEN ! Observation & model comparison 310 313 CALL dia_obs_init ! Initialize observational data 311 314 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 312 315 ENDIF 313 316 ! ! Assimilation increments 314 IF( lk_asminc )CALL asm_inc_init ! Initialize assimilation increments317 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 315 318 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 316 319 ! -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/step.F90
r2382 r2392 186 186 IF( lk_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 187 187 CALL tra_adv ( kstp ) ! horizontal & vertical advection 188 IF( n_cla == 1 ) CALL tra_cla ( kstp ) ! Cross Land Advection (Update Hor. advection)189 188 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 190 189 CALL tra_ldf ( kstp ) ! lateral mixing -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r2382 r2392 31 31 USE traadv ! advection scheme control (tra_adv_ctl routine) 32 32 USE traldf ! lateral mixing (tra_ldf routine) 33 USE cla ! cross land advection (tra_cla routine)34 33 ! zdfkpp ! KPP non-local tracer fluxes (tra_kpp routine) 35 34 USE trazdf ! vertical mixing (tra_zdf routine)
Note: See TracChangeset
for help on using the changeset viewer.