- Timestamp:
- 2015-06-18T08:37:20+02:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 3 edited
-
dia25h.F90 (modified) (16 diffs)
-
diainsitutem.F90 (modified) (6 diffs)
-
diatmb.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r5260 r5433 8 8 USE oce ! ocean dynamics and tracers variables 9 9 USE dom_oce ! ocean space and time domain 10 USE diainsitutem, ONLY: insitu_t, theta2t10 USE diainsitutem, ONLY: rinsitu_t, theta2t 11 11 USE in_out_manager ! I/O units 12 12 USE iom ! I/0 library … … 28 28 29 29 !! * variables for calculating 25-hourly means 30 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h, insitu_t_25h30 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h, rinsitu_t_25h 31 31 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_25h 32 32 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: un_25h , vn_25h , wn_25h … … 36 36 #endif 37 37 #if defined key_zdfgls 38 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: mxln_25h38 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rmxln_25h 39 39 #endif 40 40 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means … … 94 94 CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' ) ; RETURN 95 95 ENDIF 96 ALLOCATE( insitu_t_25h(jpi,jpj,jpk), STAT=ierror )97 IF( ierror > 0 ) THEN 98 CALL ctl_stop( 'dia_25h: unable to allocate insitu_t_25h' ) ; RETURN96 ALLOCATE( rinsitu_t_25h(jpi,jpj,jpk), STAT=ierror ) 97 IF( ierror > 0 ) THEN 98 CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' ) ; RETURN 99 99 ENDIF 100 100 ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror ) … … 125 125 #endif 126 126 # if defined key_zdfgls 127 ALLOCATE( mxln_25h(jpi,jpj,jpk), STAT=ierror )128 IF( ierror > 0 ) THEN 129 CALL ctl_stop( 'dia_25h: unable to allocate mxln_25h' ) ; RETURN127 ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 128 IF( ierror > 0 ) THEN 129 CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' ) ; RETURN 130 130 ENDIF 131 131 #endif … … 141 141 sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 142 142 CALL theta2t 143 insitu_t_25h(:,:,:) =insitu_t(:,:,:)143 rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 144 144 sshn_25h(:,:) = sshb(:,:) 145 145 un_25h(:,:,:) = ub(:,:,:) … … 152 152 #endif 153 153 # if defined key_zdfgls 154 mxln_25h(:,:,:) = mxln(:,:,:)154 rmxln_25h(:,:,:) = mxln(:,:,:) 155 155 #endif 156 156 #if defined key_lim3 || defined key_lim2 … … 200 200 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! temporary workspace 201 201 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 202 INTEGER :: nyear0, nmonth0,nday0 ! start year,month,day202 INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day 203 203 204 204 !!---------------------------------------------------------------------- … … 235 235 sn_25h(:,:,:) = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 236 236 CALL theta2t 237 insitu_t_25h(:,:,:) = insitu_t_25h(:,:,:) +insitu_t(:,:,:)237 rinsitu_t_25h(:,:,:) = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:) 238 238 sshn_25h(:,:) = sshn_25h(:,:) + sshn (:,:) 239 239 un_25h(:,:,:) = un_25h(:,:,:) + un(:,:,:) … … 246 246 #endif 247 247 # if defined key_zdfgls 248 mxln_25h(:,:,:) =mxln_25h(:,:,:) + mxln(:,:,:)248 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 249 249 #endif 250 250 cnt_25h = cnt_25h + 1 … … 266 266 tn_25h(:,:,:) = tn_25h(:,:,:) / 25.0_wp 267 267 sn_25h(:,:,:) = sn_25h(:,:,:) / 25.0_wp 268 insitu_t_25h(:,:,:) =insitu_t_25h(:,:,:) / 25.0_wp268 rinsitu_t_25h(:,:,:) = rinsitu_t_25h(:,:,:) / 25.0_wp 269 269 sshn_25h(:,:) = sshn_25h(:,:) / 25.0_wp 270 270 un_25h(:,:,:) = un_25h(:,:,:) / 25.0_wp … … 277 277 #endif 278 278 # if defined key_zdfgls 279 mxln_25h(:,:,:) =mxln_25h(:,:,:) / 25.0_wp279 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 280 280 #endif 281 281 … … 286 286 CALL iom_put("temper25h", zw3d) ! potential temperature 287 287 CALL theta2t ! calculate insitu temp 288 zw3d(:,:,:) = insitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))288 zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 289 289 CALL iom_put("tempis25h", zw3d) ! in-situ temperature 290 290 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) … … 311 311 #endif 312 312 #if defined key_zdfgls 313 zw3d(:,:,:) = mxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))313 zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 314 314 CALL iom_put( "mxln25h",zw3d) 315 315 #endif … … 319 319 sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 320 320 CALL theta2t 321 insitu_t_25h(:,:,:) =insitu_t(:,:,:)321 rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 322 322 sshn_25h(:,:) = sshn (:,:) 323 323 un_25h(:,:,:) = un(:,:,:) … … 330 330 #endif 331 331 # if defined key_zdfgls 332 mxln_25h(:,:,:) = mxln(:,:,:)332 rmxln_25h(:,:,:) = mxln(:,:,:) 333 333 #endif 334 334 cnt_25h = 1 -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diainsitutem.F90
r5260 r5433 22 22 PUBLIC insitu_tem_alloc ! routines called by step.F90 23 23 24 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: insitu_t24 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: rinsitu_t 25 25 26 26 !! * Substitutions … … 36 36 ierr = 0 37 37 ! 38 ALLOCATE( insitu_t(jpi,jpj,jpk), STAT=ierr(1) )38 ALLOCATE( rinsitu_t(jpi,jpj,jpk), STAT=ierr(1) ) 39 39 ! 40 40 insitu_tem_alloc = MAXVAL(ierr) … … 54 54 SUBROUTINE theta2t() 55 55 56 INTEGER, PARAMETER :: num_steps=10 ! number of steps in integration57 INTEGER :: step ! iteration counter56 INTEGER, PARAMETER :: inum_steps=10 ! number of steps in integration 57 INTEGER :: jstep ! iteration counter 58 58 INTEGER :: ji, jj, jk ! loop indices 59 59 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zP ! pressure (decibars) … … 76 76 DO ji = 1, jpi 77 77 ! These loops expanded for case where fsdept may be 1D 78 zDP(ji,jj,jk) = fsdept(ji,jj,jk) / real( num_steps)78 zDP(ji,jj,jk) = fsdept(ji,jj,jk) / real(inum_steps) 79 79 END DO 80 80 END DO … … 91 91 zTB(:,:,:) = zT(:,:,:) - zLAPSE(:,:,:) * zDP(:,:,:) 92 92 93 interation: DO step=1,num_steps93 interation: DO jstep=1, inum_steps 94 94 ! Calculate lapse rate (dT/dP) and hence TA 95 95 CALL ATG(zP, zT, zSS, zLAPSE) … … 102 102 END DO interation 103 103 104 insitu_t(:,:,:) = zT(:,:,:) * tmask(:,:,:)105 CALL lbc_lnk( insitu_t, 'T', 1.0)104 rinsitu_t(:,:,:) = zT(:,:,:) * tmask(:,:,:) 105 CALL lbc_lnk( rinsitu_t, 'T', 1.0) 106 106 107 107 END SUBROUTINE theta2t -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r4756 r5433 62 62 END SUBROUTINE dia_tmb_init 63 63 64 SUBROUTINE dia_calctmb( infield,outtmb )64 SUBROUTINE dia_calctmb( pinfield,pouttmb ) 65 65 !!--------------------------------------------------------------------- 66 66 !! *** ROUTINE dia_tmb *** … … 81 81 82 82 ! Routine arguments 83 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN ) :: infield ! Input 3d field and mask84 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( OUT) :: outtmb ! Output top, middle, bottom83 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN ) :: pinfield ! Input 3d field and mask 84 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( OUT) :: pouttmb ! Output top, middle, bottom 85 85 86 86 … … 95 95 96 96 ! Calculate top 97 outtmb(:,:,1) =infield(:,:,1)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))97 pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 98 98 99 99 ! Calculate middle 100 DO j i = 1,jpi101 DO j j = 1,jpj100 DO jj = 1,jpj 101 DO ji = 1,jpi 102 102 jk = max(1,mbathy(ji,jj)/2) 103 outtmb(ji,jj,2) =infield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk))103 pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 104 104 END DO 105 105 END DO 106 106 107 107 ! Calculate bottom 108 DO j i = 1,jpi109 DO j j = 1,jpj108 DO jj = 1,jpj 109 DO ji = 1,jpi 110 110 jk = max(1,mbathy(ji,jj) - 1) 111 outtmb(ji,jj,3) =infield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk))111 pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 112 112 END DO 113 113 END DO
Note: See TracChangeset
for help on using the changeset viewer.
