MODULE usrdef_istate !!====================================================================== !! *** MODULE usrdef_istate *** !! !! === NORTH ATALNTIC ORCA025 IDEALISED OVERFLOWS === !! !! User defined : set the initial state of a user configuration !!====================================================================== !! History : 4.0 ! 2016-03 (S. Flavoni) Original code !! 4.0.4 ! 2021-07 (D. Bruciaferri) Overflows code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! usr_def_istate : initial state in Temperature and salinity !!---------------------------------------------------------------------- USE par_oce ! ocean space and time domain USE phycst ! physical constants USE dom_oce USE dtatsd ! USE in_out_manager ! I/O manager USE lib_mpp ! MPP library IMPLICIT NONE PRIVATE PUBLIC usr_def_istate ! called in istate.F90 !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id$ !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) !!---------------------------------------------------------------------- !! *** ROUTINE usr_def_istate *** !! !! ** Purpose : Initialization of the dynamics and tracers !! North Atlantic idealised overflows !! !! ** Method : - set temprature field !! - set salinity field !!---------------------------------------------------------------------- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m] REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pts ! T & S fields [Celsius ; g/kg] REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height ! INTEGER :: ji, jj, kk, num_pnt, ierr0, ierr1 INTEGER , DIMENSION(18) :: dst_ji, dst_jj ! arrays for overflow INTEGER , DIMENSION(164) :: ifr_ji, ifr_jj ! arrays for overflow INTEGER , ALLOCATABLE , DIMENSION(:) :: ovf_ji, ovf_jj ! arrays for overflow !!---------------------------------------------------------------------- ! IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'usr_def_istate : analytical definition of initial state ' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ Ocean at rest, with a 3D uniform T and S' IF(lwp) WRITE(numout,*) ' and cold dense blobs in the DS and/or IFR' ! pu (:,:,:) = 0._wp ! ocean at rest pv (:,:,:) = 0._wp pssh(:,:) = 0._wp ! ! 3D uniform T & S profiles pts(:, :, :, jp_tem) = rn_tem_env pts(:, :, :, jp_sal) = rn_sal_env ! ! Denmark Strait idealised overflow dst_ji = (/ & & 1041, 1041, & & 1042, 1042, 1042, & & 1043, 1043, 1043, & & 1044, 1044, 1044, & & 1045, 1045, 1045, & & 1046, 1046, 1046, & & 1047 & & /) dst_jj = (/ & & 1015, 1016, & & 1015, 1016, 1017, & & 1016, 1017, 1018, & & 1017, 1018, 1019, & & 1018, 1019, 1020, & & 1019, 1020, 1021, & & 1020 & & /) ! Iceland-Faroe Ridge idealised overflow ifr_ji = (/ & & 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1104, 1091, & & 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, 1100, & & 1101, 1102, 1103, 1104, 1089, 1090, 1091, 1092, 1093, & & 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, & & 1103, 1104, 1089, 1090, 1091, 1092, 1093, 1094, 1095, & & 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1104, & & 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, & & 1098, 1099, 1100, 1101, 1102, 1103, 1104, 1089, 1090, & & 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, & & 1100, 1101, 1102, 1103, 1089, 1090, 1091, 1092, 1093, & & 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, & & 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, & & 1098, 1099, 1087, 1088, 1089, 1090, 1091, 1092, 1093, & & 1094, 1095, 1096, 1097, 1088, 1089, 1090, 1091, 1092, & & 1093, 1094, 1095, 1096, 1089, 1090, 1091, 1092, 1093, & & 1094, 1095, 1096, 1090, 1091, 1092, 1093, 1094, 1095, & & 1096, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, & & 1091, 1092, 1093, 1094, 1095, 1096, 1091, 1092, 1093, & & 1094, 1095 & & /) ifr_jj = (/ & & 996 , 996 , 996 , 996 , 996 , 996 , 996 , 996 , 997 , & & 997 , 997 , 997 , 997 , 997 , 997 , 997 , 997 , 997 , & & 997 , 997 , 997 , 997 , 998 , 998 , 998 , 998 , 998 , & & 998 , 998 , 998 , 998 , 998 , 998 , 998 , 998 , 998 , & & 998 , 998 , 999 , 999 , 999 , 999 , 999 , 999 , 999 , & & 999 , 999 , 999 , 999 , 999 , 999 , 999 , 999 , 999 , & & 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, & & 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1001, 1001, & & 1001, 1001, 1001, 1001, 1001, 1001, 1001, 1001, 1001, & & 1001, 1001, 1001, 1001, 1002, 1002, 1002, 1002, 1002, & & 1002, 1002, 1002, 1002, 1002, 1002, 1002, 1002, 1002, & & 1003, 1003, 1003, 1003, 1003, 1003, 1003, 1003, 1003, & & 1003, 1003, 1004, 1004, 1004, 1004, 1004, 1004, 1004, & & 1004, 1004, 1004, 1004, 1005, 1005, 1005, 1005, 1005, & & 1005, 1005, 1005, 1005, 1006, 1006, 1006, 1006, 1006, & & 1006, 1006, 1006, 1007, 1007, 1007, 1007, 1007, 1007, & & 1007, 1008, 1008, 1008, 1008, 1008, 1008, 1008, 1008, & & 1009, 1009, 1009, 1009, 1009, 1009, 1010, 1010, 1010, & & 1010, 1010 & & /) SELECT CASE(nn_ovf_loc) CASE(0) ! Denmark Strait num_pnt = SIZE(dst_ji) ALLOCATE( ovf_ji(num_pnt), STAT=ierr0 ) ALLOCATE( ovf_jj(num_pnt), STAT=ierr1 ) IF( ierr0 + ierr1 > 0 ) THEN CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' ); RETURN ENDIF ovf_ji(:) = dst_ji(:) ovf_jj(:) = dst_jj(:) CASE(1) ! Iceland-Faroe Ridge num_pnt = SIZE(ifr_ji) ALLOCATE( ovf_ji(num_pnt), STAT=ierr0 ) ALLOCATE( ovf_jj(num_pnt), STAT=ierr1 ) IF( ierr0 + ierr1 > 0 ) THEN CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays'); RETURN ENDIF ovf_ji(:) = ifr_ji(:) ovf_jj(:) = ifr_jj(:) CASE(2) ! Both num_pnt = SIZE(dst_ji) + SIZE(ifr_ji) ALLOCATE( ovf_ji(num_pnt), STAT=ierr0 ) ALLOCATE( ovf_jj(num_pnt), STAT=ierr1 ) IF( ierr0 + ierr1 > 0 ) THEN CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays'); RETURN ENDIF ovf_ji(1 : SIZE(dst_ji)) = dst_ji(:) ovf_ji(SIZE(dst_ji)+1 : num_pnt ) = ifr_ji(:) ovf_jj(1 : SIZE(dst_jj)) = dst_jj(:) ovf_jj(SIZE(dst_jj)+1 : num_pnt ) = ifr_jj(:) END SELECT ! IF( lk_mpp ) CALL mppsync DO kk = 1, num_pnt ji = ovf_ji(kk) jj = ovf_jj(kk) IF ((mi0(ji)>1 .AND. mi0(ji)1 .AND. mj0(jj)