Changeset 13694 for NEMO/branches/2020/r12377_ticket2386/src/OCE
- Timestamp:
- 2020-10-28T18:03:31+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 31 edited
-
. (modified) (1 prop)
-
src/OCE/BDY/bdyice.F90 (modified) (2 diffs)
-
src/OCE/BDY/bdyini.F90 (modified) (23 diffs)
-
src/OCE/DIA/diaptr.F90 (modified) (34 diffs)
-
src/OCE/DIU/diu_bulk.F90 (modified) (1 diff)
-
src/OCE/DOM/closea.F90 (modified) (1 diff)
-
src/OCE/DOM/daymod.F90 (modified) (1 diff)
-
src/OCE/DOM/dom_oce.F90 (modified) (1 diff)
-
src/OCE/DOM/domain.F90 (modified) (1 diff)
-
src/OCE/DYN/divhor.F90 (modified) (1 diff)
-
src/OCE/DYN/dynspg_ts.F90 (modified) (2 diffs)
-
src/OCE/DYN/dynvor.F90 (modified) (3 diffs)
-
src/OCE/DYN/wet_dry.F90 (modified) (2 diffs)
-
src/OCE/FLO/flo_oce.F90 (modified) (1 diff)
-
src/OCE/ICB/icbtrj.F90 (modified) (1 diff)
-
src/OCE/IOM/iom.F90 (modified) (3 diffs)
-
src/OCE/IOM/iom_def.F90 (modified) (1 diff)
-
src/OCE/ISF/isf_oce.F90 (modified) (1 diff)
-
src/OCE/LBC/lib_mpp.F90 (modified) (7 diffs)
-
src/OCE/LDF/ldftra.F90 (modified) (2 diffs)
-
src/OCE/SBC/fldread.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcfwb.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcmod.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbcwave.F90 (modified) (1 diff)
-
src/OCE/ZDF/zdfdrg.F90 (modified) (1 diff)
-
src/OCE/ZDF/zdfgls.F90 (modified) (5 diffs)
-
src/OCE/ZDF/zdfphy.F90 (modified) (1 diff)
-
src/OCE/ZDF/zdftke.F90 (modified) (1 diff)
-
src/OCE/nemogcm.F90 (modified) (3 diffs)
-
src/OCE/stpctl.F90 (modified) (5 diffs)
-
src/OCE/timing.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@135 07sette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdyice.F90
r13540 r13694 61 61 !!---------------------------------------------------------------------- 62 62 ! controls 63 IF( ln_timing ) CALL timing_start('bdy_ice_thd') ! timing 64 IF( ln_icediachk ) CALL ice_cons_hsm(0,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 65 IF( ln_icediachk ) CALL ice_cons2D (0,'bdy_ice_thd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 63 IF( ln_timing ) CALL timing_start('bdy_ice_thd') ! timing 66 64 ! 67 65 CALL ice_var_glo2eqv … … 110 108 ! 111 109 ! controls 112 IF( ln_icectl ) CALL ice_prt ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) ! prints 113 IF( ln_icediachk ) CALL ice_cons_hsm(1,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 114 IF( ln_icediachk ) CALL ice_cons2D (1,'bdy_ice_thd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) ! conservation 115 IF( ln_timing ) CALL timing_stop ('bdy_ice_thd') ! timing 110 IF( ln_icectl ) CALL ice_prt ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) ! prints 111 IF( ln_timing ) CALL timing_stop ('bdy_ice_thd') ! timing 116 112 ! 117 113 END SUBROUTINE bdy_ice -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdyini.F90
r13540 r13694 786 786 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 787 787 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 788 IF( mig (ii) > 2 .AND. mig(ii) < jpiglo-2 .AND. mjg(ij) > 2 .AND. mjg(ij) < jpjglo-2 ) THEN788 IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN 789 789 WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' 790 790 CALL ctl_stop( ctmp1 ) … … 1071 1071 SUBROUTINE bdy_read_seg( kb_bdy, knblendta ) 1072 1072 !!---------------------------------------------------------------------- 1073 !! *** ROUTINE bdy_ coords_seg ***1073 !! *** ROUTINE bdy_read_seg *** 1074 1074 !! 1075 1075 !! ** Purpose : build bdy coordinates with segments defined in namelist … … 1113 1113 nbdyind = Nj0glo - 2 ! set boundary to whole side of model domain. 1114 1114 nbdybeg = 2 1115 nbdyend = Ni0glo - 11115 nbdyend = Ni0glo - 1 1116 1116 ENDIF 1117 1117 nbdysegn = nbdysegn + 1 1118 1118 npckgn(nbdysegn) = kb_bdy ! Save bdy package number 1119 jpjnob(nbdysegn) = nbdyind + nn_hls1120 jpindt(nbdysegn) = nbdybeg + nn_hls1121 jpinft(nbdysegn) = nbdyend + nn_hls1119 jpjnob(nbdysegn) = nbdyind 1120 jpindt(nbdysegn) = nbdybeg 1121 jpinft(nbdysegn) = nbdyend 1122 1122 ! 1123 1123 CASE( 'S' ) … … 1129 1129 nbdysegs = nbdysegs + 1 1130 1130 npckgs(nbdysegs) = kb_bdy ! Save bdy package number 1131 jpjsob(nbdysegs) = nbdyind + nn_hls1132 jpisdt(nbdysegs) = nbdybeg + nn_hls1133 jpisft(nbdysegs) = nbdyend + nn_hls1131 jpjsob(nbdysegs) = nbdyind 1132 jpisdt(nbdysegs) = nbdybeg 1133 jpisft(nbdysegs) = nbdyend 1134 1134 ! 1135 1135 CASE( 'E' ) … … 1141 1141 nbdysege = nbdysege + 1 1142 1142 npckge(nbdysege) = kb_bdy ! Save bdy package number 1143 jpieob(nbdysege) = nbdyind + nn_hls1144 jpjedt(nbdysege) = nbdybeg + nn_hls1145 jpjeft(nbdysege) = nbdyend + nn_hls1143 jpieob(nbdysege) = nbdyind 1144 jpjedt(nbdysege) = nbdybeg 1145 jpjeft(nbdysege) = nbdyend 1146 1146 ! 1147 1147 CASE( 'W' ) … … 1153 1153 nbdysegw = nbdysegw + 1 1154 1154 npckgw(nbdysegw) = kb_bdy ! Save bdy package number 1155 jpiwob(nbdysegw) = nbdyind + nn_hls1156 jpjwdt(nbdysegw) = nbdybeg + nn_hls1157 jpjwft(nbdysegw) = nbdyend + nn_hls1155 jpiwob(nbdysegw) = nbdyind 1156 jpjwdt(nbdysegw) = nbdybeg 1157 jpjwft(nbdysegw) = nbdyend 1158 1158 ! 1159 1159 CASE DEFAULT ; CALL ctl_stop( 'ctypebdy must be N, S, E or W' ) … … 1197 1197 DO ib = 1, nbdysegn 1198 1198 IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib) 1199 IF ((jpjnob(ib).ge. jpjglo-1).or.&1199 IF ((jpjnob(ib).ge.Nj0glo-1).or.& 1200 1200 &(jpjnob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1201 1201 IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1202 1202 IF (jpindt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1203 IF (jpinft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1203 IF (jpinft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1204 1204 END DO 1205 1205 ! 1206 1206 DO ib = 1, nbdysegs 1207 1207 IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib) 1208 IF ((jpjsob(ib).ge. jpjglo-1).or.&1208 IF ((jpjsob(ib).ge.Nj0glo-1).or.& 1209 1209 &(jpjsob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1210 1210 IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1211 1211 IF (jpisdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1212 IF (jpisft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1212 IF (jpisft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1213 1213 END DO 1214 1214 ! 1215 1215 DO ib = 1, nbdysege 1216 1216 IF (lwp) WRITE(numout,*) '**check east seg bounds pckg: ', npckge(ib) 1217 IF ((jpieob(ib).ge. jpiglo-1).or.&1217 IF ((jpieob(ib).ge.Ni0glo-1).or.& 1218 1218 &(jpieob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1219 1219 IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1220 1220 IF (jpjedt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1221 IF (jpjeft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1221 IF (jpjeft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1222 1222 END DO 1223 1223 ! 1224 1224 DO ib = 1, nbdysegw 1225 1225 IF (lwp) WRITE(numout,*) '**check west seg bounds pckg: ', npckgw(ib) 1226 IF ((jpiwob(ib).ge. jpiglo-1).or.&1226 IF ((jpiwob(ib).ge.Ni0glo-1).or.& 1227 1227 &(jpiwob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1228 1228 IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1229 1229 IF (jpjwdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1230 IF (jpjwft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1230 IF (jpjwft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1231 1231 ENDDO 1232 1232 ! … … 1378 1378 DO ji = 1, jpi 1379 1379 DO jj = 1, jpj 1380 IF( mig (ji) == jpiwob(ib) .AND. mjg(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)1381 IF( mig (ji) == jpiwob(ib) .AND. mjg(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)1380 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1381 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1382 1382 END DO 1383 1383 END DO … … 1414 1414 DO ji = 1, jpi 1415 1415 DO jj = 1, jpj 1416 IF( mig (ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)1417 IF( mig (ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)1416 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1417 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1418 1418 END DO 1419 1419 END DO … … 1450 1450 DO ji = 1, jpi 1451 1451 DO jj = 1, jpj 1452 IF( mjg (jj) == jpjsob(ib) .AND. mig(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)1453 IF( mjg (jj) == jpjsob(ib) .AND. mig(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)1452 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1453 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1454 1454 END DO 1455 1455 END DO … … 1472 1472 DO ji = 1, jpi 1473 1473 DO jj = 1, jpj 1474 IF( mjg (jj) == jpjnob(ib)+1 .AND. mig(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)1475 IF( mjg (jj) == jpjnob(ib)+1 .AND. mig(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)1474 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1475 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1476 1476 END DO 1477 1477 END DO … … 1526 1526 DO ij = jpjedt(iseg), jpjeft(iseg) 1527 1527 icount = icount + 1 1528 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1529 nbjdta(icount, igrd, ib_bdy) = ij 1528 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1529 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1530 1530 nbrdta(icount, igrd, ib_bdy) = ir 1531 1531 ENDDO … … 1538 1538 DO ij = jpjedt(iseg), jpjeft(iseg) 1539 1539 icount = icount + 1 1540 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir 1541 nbjdta(icount, igrd, ib_bdy) = ij 1540 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir + nn_hls 1541 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1542 1542 nbrdta(icount, igrd, ib_bdy) = ir 1543 1543 ENDDO … … 1551 1551 DO ij = jpjedt(iseg), jpjeft(iseg) 1552 1552 icount = icount + 1 1553 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1554 nbjdta(icount, igrd, ib_bdy) = ij 1553 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1554 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1555 1555 nbrdta(icount, igrd, ib_bdy) = ir 1556 1556 ENDDO … … 1571 1571 DO ij = jpjwdt(iseg), jpjwft(iseg) 1572 1572 icount = icount + 1 1573 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1574 nbjdta(icount, igrd, ib_bdy) = ij 1573 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1574 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1575 1575 nbrdta(icount, igrd, ib_bdy) = ir 1576 1576 ENDDO … … 1583 1583 DO ij = jpjwdt(iseg), jpjwft(iseg) 1584 1584 icount = icount + 1 1585 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1586 nbjdta(icount, igrd, ib_bdy) = ij 1585 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1586 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1587 1587 nbrdta(icount, igrd, ib_bdy) = ir 1588 1588 ENDDO … … 1596 1596 DO ij = jpjwdt(iseg), jpjwft(iseg) 1597 1597 icount = icount + 1 1598 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1599 nbjdta(icount, igrd, ib_bdy) = ij 1598 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1599 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1600 1600 nbrdta(icount, igrd, ib_bdy) = ir 1601 1601 ENDDO … … 1616 1616 DO ii = jpindt(iseg), jpinft(iseg) 1617 1617 icount = icount + 1 1618 nbidta(icount, igrd, ib_bdy) = ii 1619 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1618 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1619 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1620 1620 nbrdta(icount, igrd, ib_bdy) = ir 1621 1621 ENDDO … … 1629 1629 DO ii = jpindt(iseg), jpinft(iseg) 1630 1630 icount = icount + 1 1631 nbidta(icount, igrd, ib_bdy) = ii 1632 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1631 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1632 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1633 1633 nbrdta(icount, igrd, ib_bdy) = ir 1634 1634 ENDDO … … 1643 1643 DO ii = jpindt(iseg), jpinft(iseg) 1644 1644 icount = icount + 1 1645 nbidta(icount, igrd, ib_bdy) = ii 1646 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir 1645 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1646 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir + nn_hls 1647 1647 nbrdta(icount, igrd, ib_bdy) = ir 1648 1648 ENDDO … … 1661 1661 DO ii = jpisdt(iseg), jpisft(iseg) 1662 1662 icount = icount + 1 1663 nbidta(icount, igrd, ib_bdy) = ii 1664 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1663 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1664 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1665 1665 nbrdta(icount, igrd, ib_bdy) = ir 1666 1666 ENDDO … … 1674 1674 DO ii = jpisdt(iseg), jpisft(iseg) 1675 1675 icount = icount + 1 1676 nbidta(icount, igrd, ib_bdy) = ii 1677 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1676 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1677 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1678 1678 nbrdta(icount, igrd, ib_bdy) = ir 1679 1679 ENDDO … … 1688 1688 DO ii = jpisdt(iseg), jpisft(iseg) 1689 1689 icount = icount + 1 1690 nbidta(icount, igrd, ib_bdy) = ii 1691 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1690 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1691 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1692 1692 nbrdta(icount, igrd, ib_bdy) = ir 1693 1693 ENDDO -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DIA/diaptr.F90
r13540 r13694 36 36 END INTERFACE 37 37 38 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines39 PUBLIC ptr_sjk !40 PUBLIC dia_ptr_init ! call in memogcm41 38 PUBLIC dia_ptr ! call in step module 42 39 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 43 40 44 ! !!** namelist namptr **45 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 46 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 47 43 48 LOGICAL , PUBLIC :: l_diaptr !: tracers trend flag (set from namelist in trdini) 49 INTEGER, PARAMETER, PUBLIC :: nptr = 5 ! (glo, atl, pac, ind, ipc) 44 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag 50 45 51 46 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 59 54 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 55 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini)56 LOGICAL :: ll_init = .TRUE. !: tracers trend flag 62 57 63 58 !! * Substitutions … … 88 83 ! 89 84 !overturning calculation 90 REAL(wp), DIMENSION( jpj,jpk,nptr) ::sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse91 REAL(wp), DIMENSION( jpj,jpk,nptr) :: zt_jk, zs_jk! i-mean T and S, j-Stream-Function92 93 REAL(wp), DIMENSION( jpi,jpj,jpk,nptr) ::z4d1, z4d294 REAL(wp), DIMENSION( jpi,jpj,nptr) :: z3dtr ! i-mean T and S, j-Stream-Function85 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 86 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 87 88 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2 89 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr 95 90 !!---------------------------------------------------------------------- 96 91 ! 97 92 IF( ln_timing ) CALL timing_start('dia_ptr') 98 93 99 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init 100 ! 101 IF( .NOT. l_diaptr ) RETURN 102 94 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin 95 ! 96 IF( .NOT. l_diaptr ) THEN 97 IF( ln_timing ) CALL timing_stop('dia_ptr') 98 RETURN 99 ENDIF 100 ! 101 ALLOCATE( z3dtr(jpi,jpj,nbasin) ) 102 ! 103 103 IF( PRESENT( pvtr ) ) THEN 104 104 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 105 DO jn = 1, nptr ! by sub-basins 105 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin) ) 106 DO jn = 1, nbasin ! by sub-basins 106 107 z4d1(1,:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) ! zonal cumulative effective transport excluding closed seas 107 108 DO jk = jpkm1, 1, -1 … … 113 114 END DO 114 115 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 116 DEALLOCATE( z4d1 ) 115 117 ENDIF 116 118 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & … … 127 129 ENDIF 128 130 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 129 DO jn = 1, nptr 131 DO jn = 1, nbasin 132 ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin), & 133 & zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 130 134 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 131 135 r1_sjk(:,:,jn) = 0._wp … … 137 141 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 138 142 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 143 DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 139 144 ! 140 145 ENDDO 141 DO jn = 1, n ptr146 DO jn = 1, nbasin 142 147 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 143 148 DO ji = 1, jpi … … 146 151 ENDDO 147 152 CALL iom_put( 'sophtove', z3dtr ) 148 DO jn = 1, n ptr153 DO jn = 1, nbasin 149 154 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 150 155 DO ji = 1, jpi … … 157 162 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 158 163 ! Calculate barotropic heat and salt transport here 159 DO jn = 1, nptr 164 DO jn = 1, nbasin 165 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 160 166 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 161 167 r1_sjk(:,1,jn) = 0._wp … … 167 173 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 168 174 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 175 DEALLOCATE( sjk, r1_sjk ) 169 176 ! 170 177 ENDDO 171 DO jn = 1, n ptr178 DO jn = 1, nbasin 172 179 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 173 180 DO ji = 1, jpi … … 176 183 ENDDO 177 184 CALL iom_put( 'sophtbtr', z3dtr ) 178 DO jn = 1, n ptr185 DO jn = 1, nbasin 179 186 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 180 187 DO ji = 1, jpi … … 190 197 zts(:,:,:,:) = 0._wp 191 198 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 199 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 192 200 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 193 201 zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) … … 197 205 END_3D 198 206 ! 199 DO jn = 1, n ptr207 DO jn = 1, nbasin 200 208 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 209 DO ji = 1, jpi 210 zmask(ji,:,:) = zmask(1,:,:) 211 ENDDO 201 212 z4d1(:,:,:,jn) = zmask(:,:,:) 202 213 ENDDO 203 214 CALL iom_put( 'zosrf', z4d1 ) 204 215 ! 205 DO jn = 1, n ptr216 DO jn = 1, nbasin 206 217 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 207 218 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) … … 212 223 CALL iom_put( 'zotem', z4d2 ) 213 224 ! 214 DO jn = 1, n ptr225 DO jn = 1, nbasin 215 226 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 216 227 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) … … 220 231 ENDDO 221 232 CALL iom_put( 'zosal', z4d2 ) 233 DEALLOCATE( z4d1, z4d2 ) 222 234 ! 223 235 ENDIF … … 226 238 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 227 239 ! 228 DO jn = 1, n ptr240 DO jn = 1, nbasin 229 241 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 230 242 DO ji = 1, jpi … … 233 245 ENDDO 234 246 CALL iom_put( 'sophtadv', z3dtr ) 235 DO jn = 1, n ptr247 DO jn = 1, nbasin 236 248 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 237 249 DO ji = 1, jpi … … 244 256 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 245 257 ! 246 DO jn = 1, n ptr258 DO jn = 1, nbasin 247 259 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 248 260 DO ji = 1, jpi … … 251 263 ENDDO 252 264 CALL iom_put( 'sophtldf', z3dtr ) 253 DO jn = 1, n ptr265 DO jn = 1, nbasin 254 266 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 255 267 DO ji = 1, jpi … … 262 274 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 263 275 ! 264 DO jn = 1, n ptr276 DO jn = 1, nbasin 265 277 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 266 278 DO ji = 1, jpi … … 269 281 ENDDO 270 282 CALL iom_put( 'sophteiv', z3dtr ) 271 DO jn = 1, n ptr283 DO jn = 1, nbasin 272 284 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 273 285 DO ji = 1, jpi … … 287 299 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 288 300 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 289 DO jn = 1, n ptr301 DO jn = 1, nbasin 290 302 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 291 303 DO ji = 1, jpi … … 294 306 ENDDO 295 307 CALL iom_put( 'sophtvtr', z3dtr ) 296 DO jn = 1, n ptr308 DO jn = 1, nbasin 297 309 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 298 310 DO ji = 1, jpi … … 311 323 ENDIF 312 324 ! 325 DEALLOCATE( z3dtr ) 326 ! 313 327 IF( ln_timing ) CALL timing_stop('dia_ptr') 314 328 ! … … 320 334 !! *** ROUTINE dia_ptr_init *** 321 335 !! 322 !! ** Purpose : Initialization , namelist read336 !! ** Purpose : Initialization 323 337 !!---------------------------------------------------------------------- 324 338 INTEGER :: inum, jn ! local integers … … 326 340 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 327 341 !!---------------------------------------------------------------------- 328 329 l_diaptr = .FALSE. 330 IF( iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 331 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 332 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 333 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 334 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 335 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) ) l_diaptr = .TRUE. 336 342 343 ! l_diaptr is defined with iom_use 344 ! --> dia_ptr_init must be done after the call to iom_init 345 ! --> cannot be .TRUE. without cpp key: key_iom --> nbasin define by iom_init is initialized 346 l_diaptr = iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 347 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 348 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 349 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 350 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 351 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 337 352 338 353 IF(lwp) THEN ! Control print … … 340 355 WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 341 356 WRITE(numout,*) '~~~~~~~~~~~~' 342 WRITE(numout,*) ' Namelist namptr : set ptr parameters'343 357 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 344 358 ENDIF … … 347 361 ! 348 362 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 349 363 ! 350 364 rc_pwatt = rc_pwatt * rho0_rcp ! conversion from K.s-1 to PetaWatt 351 365 rc_ggram = rc_ggram * rho0 ! conversion from m3/s to Gg/s … … 354 368 355 369 btmsk(:,:,1) = tmask_i(:,:) 356 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 357 CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 358 CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 359 CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) ) ! Indian basin 360 CALL iom_close( inum ) 361 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 362 DO jn = 2, nptr 363 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 370 IF( nbasin == 5 ) THEN ! nbasin has been initialized in iom_init to define the axis "basin" 371 CALL iom_open( 'subbasins', inum ) 372 CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 373 CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 374 CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) ) ! Indian basin 375 CALL iom_close( inum ) 376 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 377 ENDIF 378 DO jn = 2, nbasin 379 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 364 380 END DO 365 381 ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations … … 370 386 END WHERE 371 387 btmsk34(:,:,1) = btmsk(:,:,1) 372 DO jn = 2, n ptr373 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only388 DO jn = 2, nbasin 389 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only 374 390 ENDDO 375 391 … … 405 421 IF( cptr == 'adv' ) THEN 406 422 IF( ktra == jp_tem ) THEN 407 DO jn = 1, n ptr423 DO jn = 1, nbasin 408 424 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 409 425 ENDDO 410 426 ENDIF 411 427 IF( ktra == jp_sal ) THEN 412 DO jn = 1, n ptr428 DO jn = 1, nbasin 413 429 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 414 430 ENDDO … … 418 434 IF( cptr == 'ldf' ) THEN 419 435 IF( ktra == jp_tem ) THEN 420 DO jn = 1, n ptr436 DO jn = 1, nbasin 421 437 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 422 438 ENDDO 423 439 ENDIF 424 440 IF( ktra == jp_sal ) THEN 425 DO jn = 1, n ptr441 DO jn = 1, nbasin 426 442 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 427 443 ENDDO … … 431 447 IF( cptr == 'eiv' ) THEN 432 448 IF( ktra == jp_tem ) THEN 433 DO jn = 1, n ptr449 DO jn = 1, nbasin 434 450 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 435 451 ENDDO 436 452 ENDIF 437 453 IF( ktra == jp_sal ) THEN 438 DO jn = 1, n ptr454 DO jn = 1, nbasin 439 455 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 440 456 ENDDO … … 444 460 IF( cptr == 'vtr' ) THEN 445 461 IF( ktra == jp_tem ) THEN 446 DO jn = 1, n ptr462 DO jn = 1, nbasin 447 463 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 448 464 ENDDO 449 465 ENDIF 450 466 IF( ktra == jp_sal ) THEN 451 DO jn = 1, n ptr467 DO jn = 1, nbasin 452 468 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 453 469 ENDDO … … 467 483 ierr(:) = 0 468 484 ! 485 ! nbasin has been initialized in iom_init to define the axis "basin" 486 ! 469 487 IF( .NOT. ALLOCATED( btmsk ) ) THEN 470 ALLOCATE( btmsk(jpi,jpj,n ptr) , btmsk34(jpi,jpj,nptr), &471 & hstr_adv(jpj,jpts,n ptr), hstr_eiv(jpj,jpts,nptr), &472 & hstr_ove(jpj,jpts,n ptr), hstr_btr(jpj,jpts,nptr), &473 & hstr_ldf(jpj,jpts,n ptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1) )488 ALLOCATE( btmsk(jpi,jpj,nbasin) , btmsk34(jpi,jpj,nbasin), & 489 & hstr_adv(jpj,jpts,nbasin), hstr_eiv(jpj,jpts,nbasin), & 490 & hstr_ove(jpj,jpts,nbasin), hstr_btr(jpj,jpts,nbasin), & 491 & hstr_ldf(jpj,jpts,nbasin), hstr_vtr(jpj,jpts,nbasin), STAT=ierr(1) ) 474 492 ! 475 493 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DIU/diu_bulk.F90
r13540 r13694 22 22 23 23 ! Namelist parameters 24 LOGICAL, PUBLIC :: ln_diurnal 25 LOGICAL, PUBLIC :: ln_diurnal_only 24 LOGICAL, PUBLIC :: ln_diurnal = .false. ! force definition if diurnal_sst_bulk_init is not called 25 LOGICAL, PUBLIC :: ln_diurnal_only = .false. ! force definition if diurnal_sst_bulk_init is not called 26 26 27 27 ! Parameters -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DOM/closea.F90
r13540 r13694 38 38 LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask) 39 39 40 LOGICAL, PUBLIC :: l_sbc_clo !: T => net evap/precip over closed seas spread outover the globe/river mouth 41 LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF) to specified runoff points. 42 43 INTEGER, PUBLIC :: ncsg !: number of closed seas global mappings (inferred from closea_mask_glo field) 44 INTEGER, PUBLIC :: ncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 45 INTEGER, PUBLIC :: ncse !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 40 ! WARNING: keep default definitions in the following lines as dom_clo is called only if ln_closea = .true. 41 LOGICAL, PUBLIC :: l_sbc_clo = .FALSE. !: T => net evap/precip over closed seas spread outover the globe/river mouth 42 LOGICAL, PUBLIC :: l_clo_rnf = .FALSE. !: T => Some closed seas output freshwater (RNF) to specified runoff points. 43 44 INTEGER, PUBLIC :: ncsg = 0 !: number of closed seas global mappings (inferred from closea_mask_glo field) 45 INTEGER, PUBLIC :: ncsr = 0 !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 46 INTEGER, PUBLIC :: ncse = 0 !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 46 47 47 48 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef !: mask defining the open sea and the undefined closed sea -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DOM/daymod.F90
r13540 r13694 82 82 ndt05 = NINT( 0.5 * rn_Dt ) 83 83 84 IF( .NOT. l_offline ) CALL day_rst( nit000, 'READ' ) 85 84 lrst_oce = .NOT. l_offline ! force definition of offline 85 IF( lrst_oce ) CALL day_rst( nit000, 'READ' ) 86 86 87 ! set the calandar from ndastp (read in restart file and namelist) 87 88 nyear = ndastp / 10000 -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DOM/dom_oce.F90
r13540 r13694 220 220 221 221 !!---------------------------------------------------------------------- 222 !! variable defined here to avoid circular dependencies... 223 !! --------------------------------------------------------------------- 224 INTEGER, PUBLIC :: nbasin ! number of basin to be considered in diaprt (glo, atl, pac, ind, ipc) 225 226 !!---------------------------------------------------------------------- 222 227 !! agrif domain 223 228 !!---------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DOM/domain.F90
r13540 r13694 120 120 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 121 121 ENDIF 122 nn_wxios = 0123 ln_xios_read = .FALSE.124 122 ! 125 123 ! !== Reference coordinate system ==! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/divhor.F90
r13540 r13694 78 78 ! 79 79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !== Horizontal divergence ==! 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) &80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & 82 82 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) & -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/dynspg_ts.F90
r13540 r13694 917 917 CALL iom_get( numror, jpdom_auto, 'ub2_i_b' , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios ) 918 918 CALL iom_get( numror, jpdom_auto, 'vb2_i_b' , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 919 ELSE 920 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 919 921 ENDIF 920 922 #endif … … 922 924 IF(lwp) WRITE(numout,*) 923 925 IF(lwp) WRITE(numout,*) ' ==>>> start from rest: set barotropic values to 0' 924 ub2_b (:,:) = 0._wp ; vb2_b(:,:) = 0._wp ! used in the 1st interpol of agrif925 un_adv (:,:) = 0._wp ; vn_adv(:,:) = 0._wp ! used in the 1st interpol of agrif926 un_bf (:,:) = 0._wp ; vn_bf(:,:) = 0._wp ! used in the 1st update of agrif926 ub2_b (:,:) = 0._wp ; vb2_b (:,:) = 0._wp ! used in the 1st interpol of agrif 927 un_adv (:,:) = 0._wp ; vn_adv (:,:) = 0._wp ! used in the 1st interpol of agrif 928 un_bf (:,:) = 0._wp ; vn_bf (:,:) = 0._wp ! used in the 1st update of agrif 927 929 #if defined key_agrif 928 IF ( .NOT.Agrif_Root() ) THEN 929 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 930 ENDIF 930 ub2_i_b(:,:) = 0._wp ; vb2_i_b(:,:) = 0._wp ! used in the 1st update of agrif 931 931 #endif 932 932 ENDIF -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/dynvor.F90
r13540 r13694 217 217 INTEGER :: ji, jj, jk ! dummy loop indices 218 218 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 219 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwt ! 2D workspace220 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwz ! 3D workspace219 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwt ! 2D workspace 220 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 221 221 !!---------------------------------------------------------------------- 222 222 ! … … 533 533 REAL(wp) :: zua, zva ! local scalars 534 534 REAL(wp) :: zmsk, ze3f ! local scalars 535 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , z1_e3f536 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse537 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwz535 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , z1_e3f 536 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 537 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 538 538 !!---------------------------------------------------------------------- 539 539 ! … … 677 677 REAL(wp) :: zua, zva ! local scalars 678 678 REAL(wp) :: zmsk, z1_e3t ! local scalars 679 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy680 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse681 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwz679 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy 680 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 681 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined 682 682 !!---------------------------------------------------------------------- 683 683 ! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/wet_dry.F90
r13540 r13694 57 57 REAL(wp), PUBLIC :: ssh_ref !: height of z=0 with respect to the geoid; 58 58 59 LOGICAL, PUBLIC :: ll_wd !: Wetting/drying activation switch if either ln_wd_il or ln_wd_dl59 LOGICAL, PUBLIC :: ll_wd = .FALSE. !: Wetting/drying activation switch (ln_wd_il or ln_wd_dl) <- default def if wad_init not called 60 60 61 61 PUBLIC wad_init ! initialisation routine called by step.F90 … … 111 111 112 112 r_rn_wdmin1 = 1 / rn_wdmin1 113 ll_wd = .FALSE.114 113 IF( ln_wd_il .OR. ln_wd_dl ) THEN 115 114 ll_wd = .TRUE. -
NEMO/branches/2020/r12377_ticket2386/src/OCE/FLO/flo_oce.F90
r11536 r13694 19 19 !! ---------------- 20 20 LOGICAL, PUBLIC :: ln_floats !: Activate floats or not 21 INTEGER, PUBLIC :: jpnfl 21 INTEGER, PUBLIC :: jpnfl = 0 !: total number of floats during the run 22 22 INTEGER, PUBLIC :: jpnnewflo !: number of floats added in a new run 23 23 INTEGER, PUBLIC :: jpnrstflo !: number of floats for the restart -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ICB/icbtrj.F90
r13540 r13694 35 35 PUBLIC icb_trj_end ! routine called in icbstp.F90 module 36 36 37 INTEGER :: num_traj 37 INTEGER :: num_traj = 0 38 38 INTEGER :: n_dim, m_dim 39 39 INTEGER :: ntrajid -
NEMO/branches/2020/r12377_ticket2386/src/OCE/IOM/iom.F90
r13542 r13694 123 123 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 124 124 LOGICAL :: ll_closedef 125 LOGICAL :: ll_exist 125 126 !!---------------------------------------------------------------------- 126 127 ! … … 232 233 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 233 234 234 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )235 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 235 236 # if defined key_si3 236 237 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) … … 245 246 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 246 247 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 247 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,5) /) ) 248 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 249 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 250 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 251 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 248 252 ENDIF 249 253 ! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/IOM/iom_def.F90
r13540 r13694 33 33 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 34 34 !XIOS write restart 35 LOGICAL, PUBLIC :: lwxios 36 INTEGER, PUBLIC :: nxioso !: type of restart file when writing using XIOS 1 - single, 2 - multiple35 LOGICAL, PUBLIC :: lwxios = .FALSE. !: write single file restart using XIOS 36 INTEGER, PUBLIC :: nxioso = 0 !: type of restart file when writing using XIOS 1 - single, 2 - multiple 37 37 !XIOS read restart 38 LOGICAL, PUBLIC :: lrxios 38 LOGICAL, PUBLIC :: lrxios = .FALSE. !: read single file restart using XIOS 39 39 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 40 40 LOGICAL, PUBLIC :: lxios_set = .FALSE. -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ISF/isf_oce.F90
r12077 r13694 74 74 ! 75 75 ! 2.1 -------- ice shelf cavity parameter -------------- 76 LOGICAL , PUBLIC :: l_isfoasis 76 LOGICAL , PUBLIC :: l_isfoasis = .FALSE. 77 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfload !: ice shelf load 78 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf_oasis -
NEMO/branches/2020/r12377_ticket2386/src/OCE/LBC/lib_mpp.F90
r13540 r13694 511 511 ALLOCATE(todelay(idvar)%y1d(isz)) 512 512 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 513 ndelayid(idvar) = MPI_REQUEST_NULL ! initialised request to a valid value 513 514 END IF 514 515 ENDIF … … 518 519 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 519 520 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 520 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d521 ENDIF 522 523 IF( ndelayid(idvar) > 0 )CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received521 ndelayid(idvar) = MPI_REQUEST_NULL 522 ENDIF 523 524 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 524 525 525 526 ! send back pout from todelay(idvar)%z1d defined at previous call … … 530 531 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 531 532 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 532 ndelayid(idvar) = 1533 ndelayid(idvar) = MPI_REQUEST_NULL 533 534 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 534 535 # else … … 591 592 DEALLOCATE(todelay(idvar)%z1d) 592 593 ndelayid(idvar) = -1 ! do as if we had no restart 594 ELSE 595 ndelayid(idvar) = MPI_REQUEST_NULL 593 596 END IF 594 597 ENDIF … … 598 601 ALLOCATE(todelay(idvar)%z1d(isz)) 599 602 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 600 ENDIF 601 602 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 ndelayid(idvar) = MPI_REQUEST_NULL 604 ENDIF 605 606 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 603 607 604 608 ! send back pout from todelay(idvar)%z1d defined at previous call … … 606 610 607 611 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 612 ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 608 613 # if defined key_mpi2 609 614 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 610 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar),ierr )615 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ierr ) 611 616 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 612 617 # else … … 631 636 !!---------------------------------------------------------------------- 632 637 #if defined key_mpp_mpi 633 IF( ndelayid(kid) /= -2 ) THEN 634 #if ! defined key_mpi2 635 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 636 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 637 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 638 #endif 639 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 640 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 641 ENDIF 638 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 639 ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 640 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 641 IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 642 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 642 643 #endif 643 644 END SUBROUTINE mpp_delay_rcv -
NEMO/branches/2020/r12377_ticket2386/src/OCE/LDF/ldftra.F90
r13540 r13694 246 246 ENDIF 247 247 ! 248 IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 249 & CALL ctl_stop( 'ln_ldfeiv=T requires iso-neutral laplacian diffusion' ) 250 IF( ln_isfcav .AND. ln_traldf_triad ) & 251 & CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' ) 248 IF( ln_isfcav .AND. ln_traldf_triad ) CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' ) 252 249 ! 253 250 IF( nldf_tra == np_lap_i .OR. nldf_tra == np_lap_it .OR. & … … 541 538 IF( ln_traldf_blp ) CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' ) 542 539 ! 540 IF( .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 541 & CALL ctl_stop( 'ln_ldfeiv=T requires iso-neutral laplacian diffusion' ) 543 542 ! != allocate the aei arrays 544 543 ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) -
NEMO/branches/2020/r12377_ticket2386/src/OCE/SBC/fldread.F90
r13540 r13694 216 216 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 217 217 & sd(jf)%nrec(1,ibb), sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 218 WRITE(numout, *) ' zt_offset is : ',zt_offset218 IF( zt_offset /= 0._wp ) WRITE(numout, *) ' zt_offset is : ', zt_offset 219 219 ENDIF 220 220 ! temporal interpolation weights -
NEMO/branches/2020/r12377_ticket2386/src/OCE/SBC/sbcfwb.F90
r13540 r13694 94 94 snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass 95 95 snwice_mass (:,:) = 0.e0 96 snwice_fmass (:,:) = 0.e0 96 97 #endif 97 98 ! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/SBC/sbcmod.F90
r13540 r13694 252 252 sfx (:,:) = 0._wp !* salt flux due to freezing/melting 253 253 fmmflx(:,:) = 0._wp !* freezing minus melting flux 254 cloud_fra(:,:) = pp_cldf !* cloud fraction over sea ice (used in si3) 254 255 255 256 taum(:,:) = 0._wp !* wind stress module (needed in GLS in case of reduced restart) … … 336 337 IF( l_sbc_clo ) CALL sbc_clo_init ! closed sea surface initialisation 337 338 ! 338 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization339 340 IF( ln_abl ) CALL sbc_abl_init ! Atmospheric Boundary Layer (ABL)341 342 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization339 IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization 340 341 IF( ln_abl ) CALL sbc_abl_init ! Atmospheric Boundary Layer (ABL) 342 343 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 343 344 ! 344 345 ! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/SBC/sbcwave.F90
r13540 r13694 106 106 !!--------------------------------------------------------------------- 107 107 ! 108 ALLOCATE( ze3divh(jpi,jpj,jpk ) )108 ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 109 109 ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) ) 110 110 ! -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ZDF/zdfdrg.F90
r13540 r13694 383 383 IF(ll_bot) zmsk_boost(:,:) = zmsk_boost(:,:) * ssmask(:,:) ! x seafloor mask 384 384 ! 385 l_log_not_linssh = .FALSE. ! default definition 385 386 ! 386 387 SELECT CASE( ndrg ) -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ZDF/zdfgls.F90
r13540 r13694 327 327 ! at k=2, set de/dz=Fw 328 328 !cbr 329 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 330 zd_lw(:,:,2) = 0._wp 329 DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 330 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 331 zd_lw(ji,jj,2) = 0._wp 332 END_2D 331 333 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 332 334 zflxs(:,:) = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & … … 419 421 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 420 422 END_3D 421 DO_3D( 0, 0, 0, 0, 2, jpk )! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1423 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 422 424 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 423 425 END_3D 424 DO_3DS( 0, 0, 0, 0, jpk -1, 2, -1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk426 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 425 427 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 426 428 END_3D … … 537 539 ! 538 540 ! Neumann condition at k=2 539 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 540 zd_lw(:,:,2) = 0._wp 541 DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 542 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 543 zd_lw(ji,jj,2) = 0._wp 544 END_2D 541 545 ! 542 546 ! Set psi vertical flux at the surface: … … 613 617 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 614 618 END_3D 615 DO_3D( 0, 0, 0, 0, 2, jpk )! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1619 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 616 620 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 617 621 END_3D 618 DO_3DS( 0, 0, 0, 0, jpk -1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk622 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 619 623 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 620 624 END_3D … … 811 815 WRITE(numout,*) ' Ice-ocean roughness (used if nn_z0_ice/=0) rn_hsri = ', rn_hsri 812 816 WRITE(numout,*) 813 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:'814 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top) = ', r_z0_top815 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot) = ', r_z0_bot816 WRITE(numout,*)817 817 ENDIF 818 818 -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ZDF/zdfphy.F90
r13540 r13694 337 337 ! 338 338 END SUBROUTINE zdf_phy 339 340 339 341 INTEGER FUNCTION zdf_phy_alloc() 340 342 !!---------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/src/OCE/ZDF/zdftke.F90
r13540 r13694 678 678 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 679 679 END SELECT 680 IF( .NOT.ln_drg_OFF ) THEN681 WRITE(numout,*)682 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:'683 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top)= ', r_z0_top684 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot)= ', r_z0_bot685 ENDIF686 680 WRITE(numout,*) 687 681 WRITE(numout,*) ' ==>>> critical Richardson nb with your parameters ri_cri = ', ri_cri -
NEMO/branches/2020/r12377_ticket2386/src/OCE/nemogcm.F90
r13540 r13694 54 54 USE asminc ! assimilation increments 55 55 USE asmbkg ! writing out state trajectory 56 USE diaptr ! poleward transports (dia_ptr_init routine)57 56 USE diadct ! sections transports (dia_dct_init routine) 58 57 USE diaobs ! Observation diagnostics (dia_obs_init routine) … … 472 471 ! ! Lateral physics 473 472 CALL ldf_tra_init ! Lateral ocean tracer physics 474 CALL ldf_eiv_init ! eddy induced velocity param. 473 CALL ldf_eiv_init ! eddy induced velocity param. must be done after ldf_tra_init 475 474 CALL ldf_dyn_init ! Lateral ocean momentum physics 476 475 … … 510 509 CALL flo_init( Nnn ) ! drifting Floats 511 510 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 512 ! CALL dia_ptr_init ! Poleward TRansports initialization513 511 CALL dia_dct_init ! Sections tranports 514 512 CALL dia_hsb_init( Nnn ) ! heat content, salt content and volume budgets -
NEMO/branches/2020/r12377_ticket2386/src/OCE/stpctl.F90
r13540 r13694 67 67 REAL(wp) :: zzz ! local real 68 68 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 70 70 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 71 71 CHARACTER(len=20) :: clname … … 125 125 ! 126 126 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain 127 ! 128 ll_0oce = .NOT. ANY( llmsk(:,:,1) ) ! no ocean point in the inner domain? 129 ! 127 130 IF( ll_wd ) THEN 128 131 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max … … 149 152 ENDIF 150 153 zmax(9) = REAL( nstop, wp ) ! stop indicator 154 ! 151 155 ! !== get global extrema ==! 152 156 ! !== done by all processes if writting run.stat ==! 153 157 IF( ll_colruns ) THEN 154 158 zmaxlocal(:) = zmax(:) 155 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 159 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 156 160 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 157 ENDIF 161 ELSE 162 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 163 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 164 ENDIF 165 ! 166 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 167 zmax(5) = -zmax(5) ! move back from max(-zz) to min(zz) : easier to manage! 168 IF( ll_colruns ) THEN 169 zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 170 zmaxlocal(5) = -zmaxlocal(5) ! move back from max(-zz) to min(zz) : easier to manage! 171 ENDIF 172 ! 158 173 ! !== write "run.stat" files ==! 159 174 ! !== done only by 1st subdomain at writting timestep ==! 160 175 IF( ll_wrtruns ) THEN 161 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 162 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 163 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 164 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 165 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 166 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 167 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 168 IF( ln_zad_Aimp ) THEN 169 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 171 ENDIF 176 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3), zmax(4) 177 DO ji = 1, 6 + 2 * COUNT( (/ln_zad_Aimp/) ) 178 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 179 END DO 172 180 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 173 181 END IF … … 175 183 ! !== done by all processes at every time step ==! 176 184 ! 177 IF( 178 & 179 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity180 & 181 & 182 & 183 & 185 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 186 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 187 & zmax(3) <= 0._wp .OR. & ! negative or zero sea surface salinity 188 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 189 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 190 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 191 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 184 192 ! 185 193 iloc(:,:) = 0 … … 221 229 ! 222 230 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 223 CALL wrt_line( ctmp2, kt, '|ssh| max', 224 CALL wrt_line( ctmp3, kt, '|U| max', 225 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) )226 CALL wrt_line( ctmp5, kt, 'Sal max', 231 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 232 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 233 CALL wrt_line( ctmp4, kt, 'Sal min', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 234 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 227 235 IF( Agrif_Root() ) THEN 228 236 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' -
NEMO/branches/2020/r12377_ticket2386/src/OCE/timing.F90
r13540 r13694 424 424 s_timer => s_timer_root 425 425 DO WHILE ( ASSOCIATED( s_timer%next ) ) 426 IF (.NOT. ASSOCIATED(s_timer%next)) EXIT426 IF (.NOT. ASSOCIATED(s_timer%next)) EXIT 427 427 IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 428 428 ALLOCATE(s_wrk) … … 432 432 ll_ord = .FALSE. 433 433 CYCLE 434 ENDIF 435 IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next436 END DO 434 ENDIF 435 IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 436 END DO 437 437 IF( ll_ord ) EXIT 438 438 END DO … … 447 447 clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)' 448 448 DO WHILE ( ASSOCIATED(s_timer) ) 449 WRITE(numtime,TRIM(clfmt)) s_timer%cname, & 450 & s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2), & 451 & s_timer%tsum_cpu ,s_timer%tsum_cpu*100./t_cpu(2) , & 452 & s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter 449 IF( s_timer%tsum_clock > 0._wp ) & 450 WRITE(numtime,TRIM(clfmt)) s_timer%cname, & 451 & s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2), & 452 & s_timer%tsum_cpu ,s_timer%tsum_cpu*100./t_cpu(2) , & 453 & s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter 453 454 s_timer => s_timer%next 454 455 END DO … … 613 614 clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)' 614 615 DO WHILE ( ASSOCIATED(sl_timer_ave) ) 615 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 616 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 617 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & 618 & sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, & 619 & sl_timer_ave%tmax_clock*100.*jpnij/tot_etime, & 620 & sl_timer_ave%tmin_clock*100.*jpnij/tot_etime, & 621 & sl_timer_ave%niter/REAL(jpnij) 616 IF( sl_timer_ave%tsum_clock > 0. ) & 617 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 618 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 619 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & 620 & sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, & 621 & sl_timer_ave%tmax_clock*100.*jpnij/tot_etime, & 622 & sl_timer_ave%tmin_clock*100.*jpnij/tot_etime, & 623 & sl_timer_ave%niter/REAL(jpnij) 622 624 sl_timer_ave => sl_timer_ave%next 623 625 END DO
Note: See TracChangeset
for help on using the changeset viewer.
