![(please configure the [header_logo] section in trac.ini)](site/little_nemo.jpg)
- Timestamp:
- 02/12/13 23:04:18 (11 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 24 edited
-
OPA_SRC/DIA/diadct.F90 (modified) (5 diffs)
-
OPA_SRC/DIA/diahth.F90 (modified) (1 diff)
-
OPA_SRC/DIA/diaptr.F90 (modified) (3 diffs)
-
OPA_SRC/DIA/diawri.F90 (modified) (4 diffs)
-
OPA_SRC/DOM/domzgr.F90 (modified) (1 diff)
-
OPA_SRC/DOM/istate.F90 (modified) (2 diffs)
-
OPA_SRC/DYN/dynnept.F90 (modified) (2 diffs)
-
OPA_SRC/DYN/dynvor.F90 (modified) (1 diff)
-
OPA_SRC/LBC/lib_mpp.F90 (modified) (1 diff)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (4 diffs)
-
OPA_SRC/SBC/sbcdcy.F90 (modified) (7 diffs)
-
OPA_SRC/SBC/sbcrnf.F90 (modified) (1 diff)
-
OPA_SRC/SBC/tide_mod.F90 (modified) (1 diff)
-
OPA_SRC/TRA/traadv_eiv.F90 (modified) (2 diffs)
-
OPA_SRC/TRA/traadv_ubs.F90 (modified) (6 diffs)
-
OPA_SRC/TRA/traldf_bilapg.F90 (modified) (1 diff)
-
OPA_SRC/TRA/traldf_iso.F90 (modified) (2 diffs)
-
OPA_SRC/TRA/trasbc.F90 (modified) (2 diffs)
-
OPA_SRC/TRD/trdmld.F90 (modified) (1 diff)
-
OPA_SRC/ZDF/zdfevd.F90 (modified) (2 diffs)
-
OPA_SRC/ZDF/zdfgls.F90 (modified) (5 diffs)
-
TOP_SRC/PISCES/p4zsink.F90 (modified) (5 diffs)
-
TOP_SRC/TRP/trcsbc.F90 (modified) (2 diffs)
-
TOP_SRC/TRP/trdmld_trc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r7 r72 38 38 USE dianam ! build name of file 39 39 USE lib_mpp ! distributed memory computing library 40 #if defined key_lim2 || defined key_lim3 41 USE ice 40 #if defined key_lim2 41 USE ice_2 42 #endif 43 #if defined key_lim3 44 USE ice_3 42 45 #endif 43 46 USE domvvl … … 362 365 WRITE(numout,*)" List of points in global domain:" 363 366 DO jpt=1,iptglo 364 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt) 367 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt),directemp(jpt) 365 368 ENDDO 366 369 ENDIF … … 403 406 404 407 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 405 WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc406 408 DO jpt = 1,iptloc 407 409 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 408 410 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 409 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo410 411 ENDDO 411 412 ENDIF … … 421 422 ENDIF 422 423 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 423 WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc424 424 DO jpt = 1,secs(jsec)%nb_point 425 425 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 426 426 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 427 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo428 427 ENDDO 429 428 ENDIF … … 626 625 ELSE ; isgnv = 1 627 626 ENDIF 628 629 IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv 627 IF( sec%slopeSection .GE. 9999. ) isgnv = 1 628 629 IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv 630 630 631 631 !--------------------------------------! -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r7 r72 313 313 ! surface boundary condition 314 314 IF( lk_vvl ) THEN ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 315 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:, jk,jp_tem) * sshn(:,:) * tmask(:,:,jk)315 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1) 316 316 ENDIF 317 317 ! integration down to ilevel -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r46 r72 455 455 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 456 456 !!---------------------------------------------------------------------- 457 IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init')458 457 459 458 REWIND( numnam ) ! Read Namelist namptr : poleward transport parameters … … 474 473 475 474 IF( ln_diaptr) THEN 475 476 IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init') 476 477 477 478 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific … … 528 529 nidom_ptr = FLIO_DOM_NONE 529 530 #endif 531 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init') 532 ! 530 533 ENDIF 531 !532 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init')533 534 ! 534 535 END SUBROUTINE dia_ptr_init -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r55 r72 173 173 z3d(:,:,jpk) = 0.e0 174 174 DO jk = 1, jpkm1 175 z3d(:,:,jk) = rau0 * un(:,:,jk) * e 1u(:,:) * fse3u(:,:,jk)175 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 176 176 END DO 177 177 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 188 188 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 189 189 DO jk = 1, jpkm1 190 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e 2v(:,:) * fse3v(:,:,jk)190 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 191 191 END DO 192 192 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 700 700 !!---------------------------------------------------------------------- 701 701 ! 702 IF( nn_timing == 1 ) CALL timing_start('dia_wri_state')703 704 702 ! 0. Initialisation 705 703 ! ----------------- … … 796 794 ENDIF 797 795 #endif 798 799 IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state')800 796 ! 801 797 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7 r72 1269 1269 ! ! ================ ! 1270 1270 ! 1271 ! ! envelop bathymetry saved in hbatt 1271 ! Fill ghost rows with appropriate values to avoid undefined e3 values with some mpp decompositions 1272 DO ji = nlci+1, jpi 1273 zenv(ji,1:nlcj) = zenv(nlci,1:nlcj) 1274 END DO 1275 ! 1276 DO jj = nlcj+1, jpj 1277 zenv(:,jj) = zenv(:,nlcj) 1278 END DO 1279 ! 1280 ! Envelope bathymetry saved in hbatt 1272 1281 hbatt(:,:) = zenv(:,:) 1273 1282 IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r61 r72 107 107 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 108 108 ! 109 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr110 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )111 !112 109 IF( cp_cfg == 'eel' ) THEN 113 110 CALL istate_eel ! EEL configuration : start from pre-defined U,V T-S fields … … 134 131 ENDDO 135 132 ENDIF 133 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr 134 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 136 135 ! 137 136 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
r1 r72 115 115 ln_neptramp, rn_htrmin, rn_htrmax 116 116 !!---------------------------------------------------------------------- 117 ! ! Dynamically allocate local work arrays118 CALL wrk_alloc( jpi, jpj , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n )119 CALL wrk_alloc( jpi, jpj, jpk, znmask )120 !121 117 ! Define the (simplified) Neptune parameters 122 118 ! ========================================== 123 119 124 !! WRITE(numout,*) ' start dynnept namelist'125 !! CALL FLUSH(numout)126 120 REWIND( numnam ) ! Read Namelist namdyn_nept: Simplified Neptune 127 121 READ ( numnam, namdyn_nept ) 128 !! WRITE(numout,*) ' dynnept namelist done'129 !! CALL FLUSH(numout)130 122 131 123 IF(lwp) THEN ! Control print 132 124 WRITE(numout,*) 133 WRITE(numout,*) 'dyn_nept_init : Simplified Neptune module enabled'125 WRITE(numout,*) 'dyn_nept_init : Simplified Neptune module' 134 126 WRITE(numout,*) '~~~~~~~~~~~~~' 135 127 WRITE(numout,*) ' --> Reading namelist namdyn_nept parameters:' 136 128 WRITE(numout,*) ' ln_neptsimp = ', ln_neptsimp 137 129 WRITE(numout,*) 138 WRITE(numout,*) ' ln_smooth_neptvel = ', ln_smooth_neptvel 139 WRITE(numout,*) ' rn_tslse = ', rn_tslse 140 WRITE(numout,*) ' rn_tslsp = ', rn_tslsp 141 WRITE(numout,*) 142 WRITE(numout,*) ' ln_neptramp = ', ln_neptramp 143 WRITE(numout,*) ' rn_htrmin = ', rn_htrmin 144 WRITE(numout,*) ' rn_htrmax = ', rn_htrmax 145 WRITE(numout,*) 146 CALL FLUSH(numout) 147 ENDIF 130 IF( ln_neptsimp ) THEN 131 WRITE(numout,*) ' ln_smooth_neptvel = ', ln_smooth_neptvel 132 WRITE(numout,*) ' rn_tslse = ', rn_tslse 133 WRITE(numout,*) ' rn_tslsp = ', rn_tslsp 134 WRITE(numout,*) 135 WRITE(numout,*) ' ln_neptramp = ', ln_neptramp 136 WRITE(numout,*) ' rn_htrmin = ', rn_htrmin 137 WRITE(numout,*) ' rn_htrmax = ', rn_htrmax 138 WRITE(numout,*) 139 ENDIF 140 ENDIF 141 ! 142 IF( .NOT. ln_neptsimp ) RETURN 143 ! ! Dynamically allocate local work arrays 144 CALL wrk_alloc( jpi, jpj , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n ) 145 CALL wrk_alloc( jpi, jpj, jpk, znmask ) 148 146 149 147 IF( ln_smooth_neptvel ) THEN … … 151 149 ELSE 152 150 IF(lwp) WRITE(numout,*) ' --> neptune velocities will not be smoothed' 153 ENDIF154 155 IF( ln_neptsimp ) THEN156 IF(lwp) WRITE(numout,*) ' --> ln_neptsimp enabled, solving for U-UN'157 ELSE158 IF(lwp) WRITE(numout,*) ' --> ln_neptsimp disabled'159 RETURN160 151 ENDIF 161 152 -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7 r72 595 595 IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 596 596 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 597 IF( .NOT.lk_vvl ) THEN 597 #if ! defined key_vvl 598 IF( .NOT.ALLOCATED(ze3f) ) THEN 598 599 ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr ) 599 600 IF( lk_mpp ) CALL mpp_sum ( ierr ) 600 601 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) 601 602 ENDIF 603 #endif 602 604 ENDIF 603 605 -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7 r72 2828 2828 2829 2829 SUBROUTINE mppstop 2830 WRITE(*,*) 'mppstop: You should not have seen this print if running in mpp mode! error?...' 2831 WRITE(*,*) 'mppstop: ..otherwise this is a stop condition raised by ctl_stop in single processor mode' 2832 STOP 2830 STOP ! non MPP case, just stop the run 2833 2831 END SUBROUTINE mppstop 2834 2832 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r66 r72 737 737 ! ! (geographical to local grid -> rotate the components) 738 738 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 739 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid740 739 IF( srcv(jpr_otx2)%laction ) THEN 741 740 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) … … 743 742 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 744 743 ENDIF 744 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 745 745 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 746 746 ENDIF … … 965 965 ! ! (geographical to local grid -> rotate the components) 966 966 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx ) 967 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid968 967 IF( srcv(jpr_itx2)%laction ) THEN 969 968 CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty ) … … 971 970 CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty ) 972 971 ENDIF 972 frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 973 973 frcv(jpr_ity1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 1st grid 974 974 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
r7 r72 102 102 rcc(:,:) = zconvrad * glamt(:,:) - rpi 103 103 ! time of midday 104 rtmd(:,:) = 0.5 - glamt(:,:) / 360.105 rtmd(:,:) = MOD( (rtmd(:,:) + 1. ), 1.)104 rtmd(:,:) = 0.5_wp - glamt(:,:) / 360._wp 105 rtmd(:,:) = MOD( (rtmd(:,:) + 1._wp) , 1._wp) 106 106 ENDIF 107 107 … … 118 118 zdsws = REAL(11 + nday_year, wp) 119 119 ! declination of the earths orbit 120 zdecrad = (-23.5 * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )120 zdecrad = (-23.5_wp * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) ) 121 121 ! Compute A and B needed to compute the time integral of the diurnal cycle 122 122 … … 136 136 DO jj = 1, jpj 137 137 DO ji = 1, jpi 138 IF ( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h138 IF ( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 139 139 ! When is it night? 140 140 ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 141 141 ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx ) 142 142 ! is it dawn or dusk? 143 IF ( ztest > 0 ) THEN143 IF ( ztest > 0._wp ) THEN 144 144 rdawn(ji,jj) = ztx 145 145 rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) ) … … 149 149 ENDIF 150 150 ELSE 151 rdawn(ji,jj) = rtmd(ji,jj) + 0.5 151 rdawn(ji,jj) = rtmd(ji,jj) + 0.5_wp 152 152 rdusk(ji,jj) = rdawn(ji,jj) 153 153 ENDIF … … 157 157 rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp ) 158 158 159 ! 2.2 Compute the scalling function: 160 ! S* = the inverse of the time integral of the diurnal cycle from dawm to dusk 159 ! 2.2 Compute the scaling function: 160 ! S* = the inverse of the time integral of the diurnal cycle from dawn to dusk 161 ! Avoid possible infinite scaling factor, associated with very short daylight 162 ! periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 161 163 DO jj = 1, jpj 162 164 DO ji = 1, jpi 163 IF ( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h 165 IF ( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 166 rscal(ji,jj) = 0.0_wp 164 167 IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN ! day time in one part 165 rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 166 rscal(ji,jj) = 1. / rscal(ji,jj) 168 IF( (rdusk(ji,jj) - rdawn(ji,jj) ) .ge. 0.001_wp ) THEN 169 rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 170 rscal(ji,jj) = 1._wp / rscal(ji,jj) 171 ENDIF 167 172 ELSE ! day time in two parts 168 rscal(ji,jj) = fintegral(0., rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) & 169 & + fintegral(rdawn(ji,jj), 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 170 rscal(ji,jj) = 1. / rscal(ji,jj) 173 IF( (rdusk(ji,jj) + (1._wp - rdawn(ji,jj)) ) .ge. 0.001_wp ) THEN 174 rscal(ji,jj) = fintegral(0._wp, rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) & 175 & + fintegral(rdawn(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 176 rscal(ji,jj) = 1. / rscal(ji,jj) 177 ENDIF 171 178 ENDIF 172 179 ELSE 173 180 IF ( raa(ji,jj) > rbb(ji,jj) ) THEN ! 24h day 174 rscal(ji,jj) = fintegral(0. , 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj))175 rscal(ji,jj) = 1. / rscal(ji,jj)181 rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 182 rscal(ji,jj) = 1._wp / rscal(ji,jj) 176 183 ELSE ! No day 177 rscal(ji,jj) = 0. e0184 rscal(ji,jj) = 0.0_wp 178 185 ENDIF 179 186 ENDIF … … 191 198 DO jj = 1, jpj 192 199 DO ji = 1, jpi 193 IF( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h200 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 194 201 ! 195 202 IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN ! day time in one part … … 218 225 ! 219 226 ELSE ! No day 220 zqsrout(ji,jj) = 0. e0227 zqsrout(ji,jj) = 0.0_wp 221 228 ENDIF 222 229 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r43 r72 346 346 ! 347 347 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 348 DO jj = 1, jpj 349 DO ji = 1, jpi 350 IF( h_rnf(ji,jj) > 0._wp ) THEN 351 jk = 2 352 DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 ; END DO 353 nk_rnf(ji,jj) = jk 354 ELSEIF( h_rnf(ji,jj) == -1 ) THEN ; nk_rnf(ji,jj) = 1355 ELSEIF( h_rnf(ji,jj) == -999 ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj)356 ELSE IF( h_rnf(ji,jj) /= 0 ) THEN357 CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 358 WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) 359 ENDIF 360 END DO 361 END DO 362 DO jj = 1, jpj ! set the associated depth 363 DO ji = 1, jpi 348 DO jj = 1, jpj 349 DO ji = 1, jpi 350 IF( h_rnf(ji,jj) > 0._wp ) THEN 351 jk = 2 352 DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 ; END DO 353 nk_rnf(ji,jj) = jk 354 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 355 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 356 ELSE 357 CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 358 WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj) 359 ENDIF 360 END DO 361 END DO 362 DO jj = 1, jpj ! set the associated depth 363 DO ji = 1, jpi 364 364 h_rnf(ji,jj) = 0._wp 365 365 DO jk = 1, nk_rnf(ji,jj) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
r1 r72 21 21 jpmax_harmo = 19 ! maximum number of harmonic 22 22 23 TYPE tide23 TYPE,PUBLIC:: tide 24 24 CHARACTER(LEN=4) :: cname_tide 25 25 REAL(wp) :: equitide -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r7 r72 168 168 DO ji = fs_2, fs_jpim1 ! vector opt. 169 169 z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) & 170 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e 1u(ji,jj) * fse3u(ji,jj,jk)170 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 171 171 END DO 172 172 END DO … … 179 179 DO ji = fs_2, fs_jpim1 ! vector opt. 180 180 z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) & 181 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e 2v(ji,jj) * fse3v(ji,jj,jk)181 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 182 182 END DO 183 183 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r7 r72 24 24 USE wrk_nemo ! Memory Allocation 25 25 USE timing ! Timing 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 27 27 28 IMPLICIT NONE … … 50 51 !! and add it to the general trend of passive tracer equations. 51 52 !! 52 !! ** Method : The upstream biased third (UBS) is order scheme based53 !! on anupstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)53 !! ** Method : The upstream biased 3rd order scheme (UBS) is based on an 54 !! upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005) 54 55 !! It is only used in the horizontal direction. 55 56 !! For example the i-component of the advective fluxes are given by : 56 !! ! e 1u e3u un ( mi(Tn) - zltu(i ) ) if un(i) >= 057 !! ! e2u e3u un ( mi(Tn) - zltu(i ) ) if un(i) >= 0 57 58 !! zwx = ! or 58 !! ! e 1u e3u un ( mi(Tn) - zltu(i+1) ) if un(i) < 059 !! ! e2u e3u un ( mi(Tn) - zltu(i+1) ) if un(i) < 0 59 60 !! where zltu is the second derivative of the before temperature field: 60 61 !! zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ] … … 67 68 !! of the scheme, is evaluated using the before velocity (forward in time). 68 69 !! Note that UBS is not positive. Do not use it on passive tracers. 69 !! On the vertical, the advection is evaluated using a TVD scheme, as70 !! the UBS have been found to be too diffusive.70 !! On the vertical, the advection is evaluated using a TVD scheme, 71 !! as the UBS have been found to be too diffusive. 71 72 !! 72 73 !! ** Action : - update (pta) with the now advective tracer trends … … 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers 83 84 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocitycomponents85 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean transport components 85 86 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 86 87 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend … … 141 142 DO jj = 1, jpjm1 142 143 DO ji = 1, fs_jpim1 ! vector opt. 143 ! upstream transport 144 ! upstream transport (x2) 144 145 zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 145 146 zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 146 147 zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 147 148 zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 148 ! centered scheme149 zcenut = 0.5 *pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) )150 zcenvt = 0.5 *pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) )151 ! UBS scheme152 zwx(ji,jj,jk) = zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk)153 zwy(ji,jj,jk) = zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk)149 ! 2nd order centered advective fluxes (x2) 150 zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ) 151 zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) ) 152 ! UBS advective fluxes 153 zwx(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 154 zwy(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) ) 154 155 END DO 155 156 END DO … … 198 199 199 200 ! Surface value 200 IF( lk_vvl ) THEN ; ztw(:,:,1) = 0.e0 ! variable volume : flux set to zero201 ELSE ; ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! free constant surface201 IF( lk_vvl ) THEN ; ztw(:,:,1) = 0.e0 ! variable volume : flux set to zero 202 ELSE ; ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! constant volume : non zero flux though z=0 202 203 ENDIF 203 204 ! upstream advection with initial mass fluxes & intermediate update -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r7 r72 248 248 ! "Poleward" diffusive heat or salt transport 249 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 250 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 251 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 252 253 ENDIF 253 254 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7 r72 212 212 ! "Poleward" diffusive heat or salt transports (T-S case only) 213 213 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 214 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 215 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 214 ! note sign is reversed to give down-gradient diffusive transports (#1043) 215 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 216 IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 216 217 ENDIF 217 218 … … 219 220 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 220 221 z2d(:,:) = 0._wp 221 zztmp = rau0 * rcp 222 ! note sign is reversed to give down-gradient diffusive transports (#1043) 223 zztmp = -1.0_wp * rau0 * rcp 222 224 DO jk = 1, jpkm1 223 225 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r43 r72 205 205 !---------------------------------------- 206 206 ! 207 zfact = 0.5e0 208 209 ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 210 IF( ln_rnf ) THEN 207 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 208 zfact = 0.5_wp 211 209 DO jj = 2, jpj 212 210 DO ji = fs_2, fs_jpim1 213 zdep = 1. / h_rnf(ji,jj) 214 zdep = zfact * zdep 215 IF ( rnf(ji,jj) /= 0._wp ) THEN 211 IF( rnf(ji,jj) /= 0._wp ) THEN 212 zdep = zfact / h_rnf(ji,jj) 216 213 DO jk = 1, nk_rnf(ji,jj) 217 214 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & … … 223 220 END DO 224 221 END DO 225 ENDIF 226 !!gm It should be useless 227 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 228 222 ENDIF 223 229 224 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 230 225 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r43 r72 760 760 ! ------------------------------------------------- 761 761 762 IF( ( lk_trdmld ) .AND. ( MOD( nitend , nn_trd ) /= 0 ) ) THEN762 IF( ( lk_trdmld ) .AND. ( MOD( nitend-nit000+1, nn_trd ) /= 0 ) ) THEN 763 763 WRITE(numout,cform_err) 764 764 WRITE(numout,*) ' Your nitend parameter, nitend = ', nitend -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r7 r72 19 19 USE zdf_oce ! ocean vertical physics variables 20 20 USE zdfkpp ! KPP vertical mixing 21 USE zdfgls ! GLS vertical mixing 21 22 USE in_out_manager ! I/O manager 22 23 USE iom ! for iom_put … … 67 68 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 68 69 IF(lwp) WRITE(numout,*) 70 ! 71 IF(lwp .AND. lk_zdfgls ) CALL ctl_warn(' No need zdf_evd with GLS closures ') 72 ! 69 73 ENDIF 70 74 -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r43 r72 43 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 44 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k ! not enhanced Kz 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avm_k ! not enhanced Kz 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k ! not enhanced Kz 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmv_k ! not enhanced Kz 45 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 46 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points … … 118 122 !!---------------------------------------------------------------------- 119 123 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 124 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 125 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), & 120 126 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 121 127 ! … … 158 164 159 165 ustars2 = 0._wp ; ustarb2 = 0._wp ; psi = 0._wp ; zwall_psi = 0._wp 166 167 IF( kt /= nit000 ) THEN ! restore before value to compute tke 168 avt (:,:,:) = avt_k (:,:,:) 169 avm (:,:,:) = avm_k (:,:,:) 170 avmu(:,:,:) = avmu_k(:,:,:) 171 avmv(:,:,:) = avmv_k(:,:,:) 172 ENDIF 160 173 161 174 ! Compute surface and bottom friction at T-points … … 881 894 ENDIF 882 895 ! 896 avt_k (:,:,:) = avt (:,:,:) 897 avm_k (:,:,:) = avm (:,:,:) 898 avmu_k(:,:,:) = avmu(:,:,:) 899 avmv_k(:,:,:) = avmv(:,:,:) 900 ! 883 901 CALL wrk_dealloc( jpi,jpj, zdep, zflxs, zhsro ) 884 902 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi ) … … 1244 1262 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1245 1263 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1246 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt 1247 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm 1248 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu 1249 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv 1264 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) 1265 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k ) 1266 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 1267 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 1250 1268 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1251 1269 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r46 r72 19 19 USE prtctl_trc ! print control for debugging 20 20 USE iom ! I/O manager 21 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 21 22 22 23 IMPLICIT NONE … … 614 615 INTEGER :: ji, jj, jk, jn 615 616 REAL(wp) :: zigma,zew,zign, zflx, zstep 616 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2 617 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2, ztrb 617 618 !!--------------------------------------------------------------------- 618 619 ! … … 620 621 ! 621 622 ! Allocate temporary workspace 622 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 )623 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) 623 624 624 625 zstep = rfact2 / 2. … … 626 627 ztraz(:,:,:) = 0.e0 627 628 zakz (:,:,:) = 0.e0 629 ztrb (:,:,:) = trn(:,:,:,jp_tra) 628 630 629 631 DO jk = 1, jpkm1 … … 695 697 DO ji = 1, jpi 696 698 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 697 trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + 2. * zflx699 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx 698 700 END DO 699 701 END DO 700 702 END DO 701 703 702 trn (:,:,:,jp_tra) = trb(:,:,:,jp_tra)704 trn (:,:,:,jp_tra) = ztrb(:,:,:) 703 705 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 704 706 ! 705 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 )707 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) 706 708 ! 707 709 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink2') -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7 r72 50 50 !! tra = tra + emp * trn / e3t for k=1 51 51 !! where emp, the surface freshwater budget (evaporation minus 52 !! precipitation minus runoff) given in kg/m2/s is divided52 !! precipitation ) given in kg/m2/s is divided 53 53 !! by 1035 kg/m3 (density of ocean water) to obtain m/s. 54 54 !! … … 79 79 ENDIF 80 80 81 ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div 82 ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 81 83 82 IF( lk_offline ) THEN ! emps in dynamical files contains emps - rnf 83 zemps(:,:) = emps(:,:) 84 ELSE ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff 85 IF( lk_vvl ) THEN ! volume variable 86 zemps(:,:) = emps(:,:) - emp(:,:) 87 !!ch zemps(:,:) = 0. 88 ELSE ! linear free surface 89 IF( ln_rnf ) THEN ; zemps(:,:) = emps(:,:) - rnf(:,:) ! E-P-R 90 ELSE ; zemps(:,:) = emps(:,:) 91 ENDIF 92 ENDIF 84 ! Coupling in offline, hdivn is computed from ocean horizontal velocities only ; the runoff are not included. 85 ! emps in dynamical files contains (emps - rnf) 86 IF( .NOT. lk_offline .AND. lk_vvl ) THEN ! online coupling + volume variable 87 zemps(:,:) = emps(:,:) - emp(:,:) 88 ELSE 89 zemps(:,:) = emps(:,:) 93 90 ENDIF 94 91 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
r46 r72 1174 1174 ! ------------------------------------------------- 1175 1175 1176 IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend , nn_trd_trc ) /= 0 ) ) THEN1176 IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend-nit000+1, nn_trd_trc ) /= 0 ) ) THEN 1177 1177 WRITE(numout,cform_err) 1178 1178 WRITE(numout,*) ' Your nitend parameter, nitend = ', nitend
Note: See TracChangeset
for help on using the changeset viewer.
