Changeset 3720 for trunk/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2012-12-04T11:10:08+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
-
DOM/domain.F90 (modified) (5 diffs)
-
DOM/domzgr.F90 (modified) (9 diffs)
-
IOM/iom.F90 (modified) (3 diffs)
-
LBC/lbclnk.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r3421 r3720 67 67 !! - 1D configuration, move Coriolis, u and v at T-point 68 68 !!---------------------------------------------------------------------- 69 INTEGER :: jk 70 INTEGER :: iconf = 0 ! temporaryintegers71 !!---------------------------------------------------------------------- 72 ! 73 IF( nn_timing == 1 ) CALL timing_start('dom_init')69 INTEGER :: jk ! dummy loop argument 70 INTEGER :: iconf = 0 ! local integers 71 !!---------------------------------------------------------------------- 72 ! 73 IF( nn_timing == 1 ) CALL timing_start('dom_init') 74 74 ! 75 75 IF(lwp) THEN … … 86 86 IF( lk_vvl ) CALL dom_vvl ! Vertical variable mesh 87 87 ! 88 IF( lk_c1d ) THEN ! 1D configuration 89 CALL cor_c1d ! Coriolis set at T-point 90 umask(:,:,:) = tmask(:,:,:) ! U, V moved at T-point 91 vmask(:,:,:) = tmask(:,:,:) 92 END IF 93 ! 94 hu(:,:) = 0.e0 ! Ocean depth at U- and V-points 95 hv(:,:) = 0.e0 88 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 89 ! 90 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 91 hv(:,:) = 0._wp 96 92 DO jk = 1, jpk 97 93 hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) … … 99 95 END DO 100 96 ! ! Inverse of the local depth 101 hur(:,:) = 1. / ( hu(:,:) + 1.e0- umask(:,:,1) ) * umask(:,:,1)102 hvr(:,:) = 1. / ( hv(:,:) + 1.e0- vmask(:,:,1) ) * vmask(:,:,1)97 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 98 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 103 99 104 100 CALL dom_stp ! time step … … 106 102 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 107 103 ! 108 IF( nn_timing == 1 ) CALL timing_stop('dom_init')104 IF( nn_timing == 1 ) CALL timing_stop('dom_init') 109 105 ! 110 106 END SUBROUTINE dom_init … … 292 288 CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 293 289 ELSE 294 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1. e0)295 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1. e0)296 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1. e0)297 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1. e0)298 299 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1. e0)290 ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 291 ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 292 ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 293 ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 294 295 iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 300 296 iimi1 = iloc(1) + nimpp - 1 301 297 ijmi1 = iloc(2) + njmpp - 1 302 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1. e0)298 iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 303 299 iimi2 = iloc(1) + nimpp - 1 304 300 ijmi2 = iloc(2) + njmpp - 1 305 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1. e0)301 iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp ) 306 302 iima1 = iloc(1) + nimpp - 1 307 303 ijma1 = iloc(2) + njmpp - 1 308 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1. e0)304 iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp ) 309 305 iima2 = iloc(1) + nimpp - 1 310 306 ijma2 = iloc(2) + njmpp - 1 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3563 r3720 15 15 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 16 16 !! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 17 !!---------------------------------------------------------------------- 17 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) modify C1D case 18 !!---------------------------------------------------------------------- 18 19 19 20 !!---------------------------------------------------------------------- … … 38 39 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 39 40 USE lib_mpp ! distributed memory computing library 40 USE wrk_nemo ! Memory allocation41 USE timing ! Timing41 USE wrk_nemo ! Memory allocation 42 USE timing ! Timing 42 43 43 44 IMPLICIT NONE … … 71 72 !! *** ROUTINE dom_zgr *** 72 73 !! 73 !! ** Purpose : set the depth of model levels and the resulting74 !! vertical scale factors.74 !! ** Purpose : set the depth of model levels and the resulting 75 !! vertical scale factors. 75 76 !! 76 77 !! ** Method : - reference 1D vertical coordinate (gdep._0, e3._0) … … 84 85 !! ** Action : define gdep., e3., mbathy and bathy 85 86 !!---------------------------------------------------------------------- 86 INTEGER :: ioptio = 0 ! temporaryinteger87 INTEGER :: ioptio, ibat ! local integer 87 88 ! 88 89 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 89 90 !!---------------------------------------------------------------------- 90 91 ! 91 IF( nn_timing == 1 ) CALL timing_start('dom_zgr')92 IF( nn_timing == 1 ) CALL timing_start('dom_zgr') 92 93 ! 93 94 REWIND( numnam ) ! Read Namelist namzgr : vertical coordinate' … … 105 106 106 107 ioptio = 0 ! Check Vertical coordinate options 107 IF( ln_zco )ioptio = ioptio + 1108 IF( ln_zps )ioptio = ioptio + 1109 IF( ln_sco )ioptio = ioptio + 1108 IF( ln_zco ) ioptio = ioptio + 1 109 IF( ln_zps ) ioptio = ioptio + 1 110 IF( ln_sco ) ioptio = ioptio + 1 110 111 IF( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 111 112 ! … … 114 115 CALL zgr_z ! Reference z-coordinate system (always called) 115 116 CALL zgr_bat ! Bathymetry fields (levels and meters) 117 IF( lk_c1d ) CALL lbc_lnk( bathy , 'T', 1._wp ) ! 1D config.: same bathy value over the 3x3 domain 116 118 IF( ln_zco ) CALL zgr_zco ! z-coordinate 117 119 IF( ln_zps ) CALL zgr_zps ! Partial step z-coordinate 118 120 IF( ln_sco ) CALL zgr_sco ! s-coordinate or hybrid z-s coordinate 119 121 ! 122 ! 120 123 ! final adjustment of mbathy & check 121 124 ! ----------------------------------- 122 125 IF( lzoom ) CALL zgr_bat_zoom ! correct mbathy in case of zoom subdomain 123 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress iso ated ocean points126 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress isolated ocean points 124 127 CALL zgr_bot_level ! deepest ocean level for t-, u- and v-points 125 128 ! 126 ! 127 129 IF( lk_c1d ) THEN ! 1D config.: same mbathy value over the 3x3 domain 130 ibat = mbathy(2,2) 131 mbathy(:,:) = ibat 132 END IF 133 ! 128 134 IF( nprint == 1 .AND. lwp ) THEN 129 135 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) … … 465 471 END DO 466 472 END DO 467 IF(lwp) WRITE(numout,*) 473 IF(lwp) WRITE(numout,*) 468 474 IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 469 475 ! … … 502 508 ENDIF 503 509 ! 510 ! 504 511 CALL wrk_dealloc( jpidta, jpjdta, idta ) 505 512 CALL wrk_dealloc( jpidta, jpjdta, zdta ) … … 729 736 ! 730 737 mbkt(:,:) = MAX( mbathy(:,:) , 1 ) ! bottom k-index of T-level (=1 over land) 738 731 739 ! ! bottom k-index of W-level = mbkt+1 732 740 DO jj = 1, jpjm1 ! bottom k-index of u- (v-) level -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3294 r3720 4 4 !! Input/Output manager : Library to read input files 5 5 !!==================================================================== 6 !! History : 9.0 ! 05 12 (J. Belier) Original code 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 !! " ! 07 07 (D. Storkey) Changes to iom_gettime 6 !! History : 2.0 ! 2005-12 (J. Belier) Original code 7 !! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO 8 !! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 9 10 !!-------------------------------------------------------------------- 10 !!gm caution add !DIR nec: improved performance to be checked as well as no result changes11 11 12 12 !!-------------------------------------------------------------------- … … 19 19 !!-------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE c1d ! 1D vertical configuration 21 22 USE flo_oce ! floats module declarations 22 23 USE lbclnk ! lateal boundary condition / mpp exchanges … … 751 752 ENDIF 752 753 754 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 755 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 756 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 757 753 758 !--- Apply scale_factor and offset 754 759 zscf = iom_file(kiomid)%scf(idvar) ! scale factor -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r2442 r3720 7 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 8 !! 3.2 ! 2009-03 (R. Benshila) External north fold treatment 9 !!---------------------------------------------------------------------- 10 #if defined key_mpp_mpi 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add a C1D case 10 !!---------------------------------------------------------------------- 11 #if defined key_mpp_mpi 11 12 !!---------------------------------------------------------------------- 12 13 !! 'key_mpp_mpi' MPI massively parallel processing library … … 67 68 !!---------------------------------------------------------------------- 68 69 CONTAINS 70 71 # if defined key_c1d 72 !!---------------------------------------------------------------------- 73 !! 'key_c1d' 1D configuration 74 !!---------------------------------------------------------------------- 75 76 SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 77 !!--------------------------------------------------------------------- 78 !! *** ROUTINE lbc_lnk_3d_gather *** 79 !! 80 !! ** Purpose : set lateral boundary conditions on two 3D arrays (C1D case) 81 !! 82 !! ** Method : call lbc_lnk_3d on pt3d1 and pt3d2 83 !!---------------------------------------------------------------------- 84 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points 85 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 86 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 87 !!---------------------------------------------------------------------- 88 ! 89 CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 90 CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 91 ! 92 END SUBROUTINE lbc_lnk_3d_gather 93 94 95 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 96 !!--------------------------------------------------------------------- 97 !! *** ROUTINE lbc_lnk_3d *** 98 !! 99 !! ** Purpose : set lateral boundary conditions on a 3D array (C1D case) 100 !! 101 !! ** Method : 1D case, the central water column is set everywhere 102 !!---------------------------------------------------------------------- 103 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 105 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 106 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 107 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 108 ! 109 INTEGER :: jk ! dummy loop index 110 REAL(wp) :: ztab ! local scalar 111 !!---------------------------------------------------------------------- 112 ! 113 DO jk = 1, jpk 114 ztab = pt3d(2,2,jk) 115 pt3d(:,:,jk) = ztab 116 END DO 117 ! 118 END SUBROUTINE lbc_lnk_3d 119 120 121 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 122 !!--------------------------------------------------------------------- 123 !! *** ROUTINE lbc_lnk_2d *** 124 !! 125 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 126 !! 127 !! ** Method : 1D case, the central water column is set everywhere 128 !!---------------------------------------------------------------------- 129 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 130 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 131 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 132 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 133 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 134 ! 135 REAL(wp) :: ztab ! local scalar 136 !!---------------------------------------------------------------------- 137 ! 138 ztab = pt2d(2,2) 139 pt2d(:,:) = ztab 140 ! 141 END SUBROUTINE lbc_lnk_2d 142 143 #else 144 !!---------------------------------------------------------------------- 145 !! Default option 3D shared memory computing 146 !!---------------------------------------------------------------------- 69 147 70 148 SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) … … 113 191 114 192 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 115 ELSE ; zland = 0. e0193 ELSE ; zland = 0._wp 116 194 ENDIF 117 195 … … 203 281 204 282 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 205 ELSE ; zland = 0. e0283 ELSE ; zland = 0._wp 206 284 ENDIF 207 285 … … 270 348 END SUBROUTINE lbc_lnk_2d 271 349 350 # endif 272 351 #endif 273 352
Note: See TracChangeset
for help on using the changeset viewer.
