- Timestamp:
- 2018-11-25T15:24:21+01:00 (5 years ago)
- Location:
- NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/iceistate.F90
r10292 r10358 477 477 !!clem: output of initial state should be written here but it is impossible because 478 478 !! the ocean and ice are in the same file 479 !! CALL dia_wri_state( 'output.init' , nit000)479 !! CALL dia_wri_state( 'output.init' ) 480 480 ! 481 481 END SUBROUTINE ice_istate -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/ICE/icewri.F90
r10314 r10358 227 227 228 228 229 SUBROUTINE ice_wri_state( k t, kid, kh_i)229 SUBROUTINE ice_wri_state( kid ) 230 230 !!--------------------------------------------------------------------- 231 231 !! *** ROUTINE ice_wri_state *** … … 238 238 !! History : 4.0 ! 2013-06 (C. Rousset) 239 239 !!---------------------------------------------------------------------- 240 INTEGER, INTENT( in ) :: kt ! ocean time-step index 241 INTEGER, INTENT( in ) :: kid , kh_i 242 INTEGER :: nz_i, jl 243 REAL(wp), DIMENSION(jpl) :: jcat 240 INTEGER, INTENT( in ) :: kid 244 241 !!---------------------------------------------------------------------- 245 242 ! 246 DO jl = 1, jpl 247 jcat(jl) = REAL(jl) 248 END DO 249 250 CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 251 252 CALL histdef( kid, "sithic", "Ice thickness" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 253 CALL histdef( kid, "siconc", "Ice concentration" , "%" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 254 CALL histdef( kid, "sitemp", "Ice temperature" , "C" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 255 CALL histdef( kid, "sivelu", "i-Ice speed " , "m/s" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 256 CALL histdef( kid, "sivelv", "j-Ice speed " , "m/s" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 257 CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 258 CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 259 CALL histdef( kid, "sisflx", "Solar flx over ocean" , "W/m2" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 260 CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 261 CALL histdef( kid, "snwpre", "Snow precipitation" , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 262 CALL histdef( kid, "sisali", "Ice salinity" , "PSU" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 263 CALL histdef( kid, "sivolu", "Ice volume" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 264 CALL histdef( kid, "sidive", "Ice divergence" , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 265 CALL histdef( kid, "si_amp", "Melt pond fraction" , "%" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 266 CALL histdef( kid, "si_vmp", "Melt pond volume" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 267 ! 268 CALL histdef( kid, "sithicat", "Ice thickness" , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 269 CALL histdef( kid, "siconcat", "Ice concentration" , "%" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 270 CALL histdef( kid, "sisalcat", "Ice salinity" , "" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 271 CALL histdef( kid, "snthicat", "Snw thickness" , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 272 273 CALL histend( kid, snc4set ) ! end of the file definition 274 275 CALL histwrite( kid, "sithic", kt, hm_i , jpi*jpj, (/1/) ) 276 CALL histwrite( kid, "siconc", kt, at_i , jpi*jpj, (/1/) ) 277 CALL histwrite( kid, "sitemp", kt, tm_i - rt0 , jpi*jpj, (/1/) ) 278 CALL histwrite( kid, "sivelu", kt, u_ice , jpi*jpj, (/1/) ) 279 CALL histwrite( kid, "sivelv", kt, v_ice , jpi*jpj, (/1/) ) 280 CALL histwrite( kid, "sistru", kt, utau_ice , jpi*jpj, (/1/) ) 281 CALL histwrite( kid, "sistrv", kt, vtau_ice , jpi*jpj, (/1/) ) 282 CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) ) 283 CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) ) 284 CALL histwrite( kid, "snwpre", kt, sprecip , jpi*jpj, (/1/) ) 285 CALL histwrite( kid, "sisali", kt, sm_i , jpi*jpj, (/1/) ) 286 CALL histwrite( kid, "sivolu", kt, vt_i , jpi*jpj, (/1/) ) 287 CALL histwrite( kid, "sidive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 288 CALL histwrite( kid, "si_amp", kt, at_ip , jpi*jpj, (/1/) ) 289 CALL histwrite( kid, "si_vmp", kt, vt_ip , jpi*jpj, (/1/) ) 290 ! 291 CALL histwrite( kid, "sithicat", kt, h_i , jpi*jpj*jpl, (/1/) ) 292 CALL histwrite( kid, "siconcat", kt, a_i , jpi*jpj*jpl, (/1/) ) 293 CALL histwrite( kid, "sisalcat", kt, s_i , jpi*jpj*jpl, (/1/) ) 294 CALL histwrite( kid, "snthicat", kt, h_s , jpi*jpj*jpl, (/1/) ) 295 296 !! The file is closed in dia_wri_state (ocean routine) 297 !! CALL histclo( kid ) 298 ! 243 !! The file is open in dia_wri_state (ocean routine) 244 245 CALL iom_rstput( 0, 0, kid, 'sithic', hm_i ) ! Ice thickness 246 CALL iom_rstput( 0, 0, kid, 'siconc', at_i ) ! Ice concentration 247 CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i - rt0 ) ! Ice temperature 248 CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice ) ! i-Ice speed 249 CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice ) ! j-Ice speed 250 CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice ) ! i-Wind stress over ice 251 CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice ) ! i-Wind stress over ice 252 CALL iom_rstput( 0, 0, kid, 'sisflx', qsr ) ! Solar flx over ocean 253 CALL iom_rstput( 0, 0, kid, 'sinflx', qns ) ! NonSolar flx over ocean 254 CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip ) ! Snow precipitation 255 CALL iom_rstput( 0, 0, kid, 'sisali', sm_i ) ! Ice salinity 256 CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i ) ! Ice volume 257 CALL iom_rstput( 0, 0, kid, 'sidive', divu_i*1.0e8 ) ! Ice divergence 258 CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip ) ! Melt pond fraction 259 CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip ) ! Melt pond volume 260 CALL iom_rstput( 0, 0, kid, 'sithicat', h_i ) ! Ice thickness 261 CALL iom_rstput( 0, 0, kid, 'siconcat', a_i ) ! Ice concentration 262 CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i ) ! Ice salinity 263 CALL iom_rstput( 0, 0, kid, 'snthicat', h_s ) ! Snw thickness 264 299 265 END SUBROUTINE ice_wri_state 300 266 -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DIA/diawri.F90
r10297 r10358 52 52 53 53 #if defined key_si3 54 USE ice 54 55 USE icewri 55 56 #endif … … 119 120 ! Output the initial state and forcings 120 121 IF( ninist == 1 ) THEN 121 CALL dia_wri_state( 'output.init' , kt)122 CALL dia_wri_state( 'output.init' ) 122 123 ninist = 0 123 124 ENDIF … … 445 446 ! 446 447 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 447 CALL dia_wri_state( 'output.init' , kt)448 CALL dia_wri_state( 'output.init' ) 448 449 ninist = 0 449 450 ENDIF … … 868 869 #endif 869 870 870 SUBROUTINE dia_wri_state( cdfile_name , kt)871 SUBROUTINE dia_wri_state( cdfile_name ) 871 872 !!--------------------------------------------------------------------- 872 873 !! *** ROUTINE dia_wri_state *** … … 882 883 !!---------------------------------------------------------------------- 883 884 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 884 INTEGER , INTENT( in ) :: kt ! ocean time-step index 885 !! 886 CHARACTER (len=32) :: clname 887 CHARACTER (len=40) :: clop 888 INTEGER :: id_i , nz_i, nh_i 889 INTEGER, DIMENSION(1) :: idex ! local workspace 890 REAL(wp) :: zsto, zout, zmax, zjulian 885 !! 886 INTEGER :: inum 891 887 !!---------------------------------------------------------------------- 892 888 ! 893 ! 0. Initialisation894 ! -----------------895 896 ! Define name, frequency of output and means897 clname = cdfile_name898 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)899 zsto = rdt900 clop = "inst(x)" ! no use of the mask value (require less cpu time)901 zout = rdt902 zmax = ( nitend - nit000 + 1 ) * rdt903 904 889 IF(lwp) WRITE(numout,*) 905 890 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 906 891 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 907 IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' 908 909 910 ! 1. Define NETCDF files and fields at beginning of first time step 911 ! ----------------------------------------------------------------- 912 913 ! Compute julian date from starting date of the run 914 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis 915 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 916 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 917 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 918 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 919 "m", jpk, gdept_1d, nz_i, "down") 920 921 ! Declare all the output fields as NetCDF variables 922 923 CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity 924 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 925 CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature 926 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 927 CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh 928 & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) 929 CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current 930 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 931 CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current 932 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 933 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 934 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 935 ! 892 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 893 894 #if defined key_si3 895 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 896 #else 897 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 898 #endif 899 900 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 901 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 902 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 903 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 904 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 905 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 936 906 IF( ALLOCATED(ahtu) ) THEN 937 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 938 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 939 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 940 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 941 ENDIF 942 IF( ALLOCATED(ahmt) ) THEN 943 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 944 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 945 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 946 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 947 ENDIF 948 ! 949 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 950 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 951 CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux 952 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 953 CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux 954 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 955 CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i 956 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 957 CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress 958 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 959 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 960 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 961 IF( .NOT.ln_linssh ) THEN 962 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 963 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 964 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 965 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 966 ENDIF 967 ! 907 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point 908 CALL iom_rstput( 0, 0, inum, 'ahtv', ahtv ) ! aht at v-point 909 ENDIF 910 IF( ALLOCATED(ahmt) ) THEN 911 CALL iom_rstput( 0, 0, inum, 'ahmt', ahmt ) ! ahmt at u-point 912 CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point 913 ENDIF 914 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 915 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux 916 CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux 917 CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction 918 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 919 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 920 IF( .NOT.ln_linssh ) THEN 921 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n ) ! T-cell depth 922 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n ) ! T-cell thickness 923 END IF 968 924 IF( ln_wave .AND. ln_sdw ) THEN 969 CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal" , "m/s" , & ! StokesDrift zonal current 970 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 971 CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid" , "m/s" , & ! StokesDrift meridonal current 972 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 973 CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert" , "m/s" , & ! StokesDrift vertical current 974 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 975 ENDIF 976 925 CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity 926 CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd ) ! now StokesDrift j-velocity 927 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 928 ENDIF 929 977 930 #if defined key_si3 978 931 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 979 CALL ice_wri_state( kt, id_i, nh_i ) 980 ENDIF 981 #else 982 CALL histend( id_i, snc4chunks=snc4set ) 932 CALL ice_wri_state( inum ) 933 ENDIF 983 934 #endif 984 985 ! 2. Start writing data 986 ! --------------------- 987 ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 988 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 989 ! donne le nombre d'elements, et idex la liste des indices a sortir 990 idex(1) = 1 ! init to avoid compil warning 991 992 ! Write all fields on T grid 993 CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature 994 CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity 995 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height 996 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity 997 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 998 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 999 ! 1000 IF( ALLOCATED(ahtu) ) THEN 1001 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 1002 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 1003 ENDIF 1004 IF( ALLOCATED(ahmt) ) THEN 1005 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 1006 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 1007 ENDIF 1008 ! 1009 CALL histwrite( id_i, "sowaflup", kt, emp - rnf , jpi*jpj , idex ) ! freshwater budget 1010 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 1011 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 1012 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 1013 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 1014 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 1015 1016 IF( .NOT.ln_linssh ) THEN 1017 CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 1018 CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )! T-cell thickness 1019 END IF 1020 1021 IF( ln_wave .AND. ln_sdw ) THEN 1022 CALL histwrite( id_i, "sdzocrtx", kt, usd , jpi*jpj*jpk, idex) ! now StokesDrift i-velocity 1023 CALL histwrite( id_i, "sdmecrty", kt, vsd , jpi*jpj*jpk, idex) ! now StokesDrift j-velocity 1024 CALL histwrite( id_i, "sdvecrtz", kt, wsd , jpi*jpj*jpk, idex) ! now StokesDrift k-velocity 1025 ENDIF 1026 1027 ! 3. Close the file 1028 ! ----------------- 1029 CALL histclo( id_i ) 1030 #if ! defined key_iomput 1031 IF( ninist /= 1 ) THEN 1032 CALL histclo( nid_T ) 1033 CALL histclo( nid_U ) 1034 CALL histclo( nid_V ) 1035 CALL histclo( nid_W ) 1036 ENDIF 1037 #endif 935 ! 936 CALL iom_close( inum ) 1038 937 ! 1039 938 END SUBROUTINE dia_wri_state -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/IOM/iom_nf90.F90
r10068 r10358 129 129 CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo) 130 130 ENDIF 131 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy), clinfo)131 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 132 132 ! define dimensions 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x' , kdompar(1,1) , idmy ), clinfo) 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y' , kdompar(2,1) , idmy ), clinfo) 135 IF( PRESENT(kdlev) ) THEN 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat' , ilevels , idmy ), clinfo) 137 ELSE 138 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', ilevels , idmy ), clinfo) 139 ENDIF 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 140 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 137 IF( PRESENT(kdlev) ) & 138 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 141 139 ! global attributes 142 140 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) … … 704 702 ! ! when appropriate (currently chunking is applied to 4d fields only) 705 703 INTEGER :: idlv ! local variable 704 INTEGER :: idim3 ! id of the third dimension 706 705 !--------------------------------------------------------------------- 707 706 ! … … 752 751 ! variable definition 753 752 IF( PRESENT(pv_r0d) ) THEN ; idims = 0 754 ELSEIF( PRESENT(pv_r1d) ) THEN ; idims = 2 ; idimid(1:idims) = (/ 3,4/) 753 ELSEIF( PRESENT(pv_r1d) ) THEN 754 IF( SIZE(pv_r1d,1) == jpk ) THEN ; idim3 = 3 755 ELSE ; idim3 = 5 756 ENDIF 757 idims = 2 ; idimid(1:idims) = (/idim3,4/) 755 758 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/) 756 ELSEIF( PRESENT(pv_r3d) ) THEN ; idims = 4 ; idimid(1:idims) = (/1,2,3,4/) 759 ELSEIF( PRESENT(pv_r3d) ) THEN 760 IF( SIZE(pv_r3d,3) == jpk ) THEN ; idim3 = 3 761 ELSE ; idim3 = 5 762 ENDIF 763 idims = 4 ; idimid(1:idims) = (/1,2,idim3,4/) 757 764 ENDIF 758 765 IF( PRESENT(ktype) ) THEN ! variable external type 759 766 SELECT CASE (ktype) 760 CASE (jp_r8) ; itype = NF90_DOUBLE761 CASE (jp_r4) ; itype = NF90_FLOAT762 CASE (jp_i4) ; itype = NF90_INT763 CASE (jp_i2) ; itype = NF90_SHORT764 CASE (jp_i1) ; itype = NF90_BYTE767 CASE (jp_r8) ; itype = NF90_DOUBLE 768 CASE (jp_r4) ; itype = NF90_FLOAT 769 CASE (jp_i4) ; itype = NF90_INT 770 CASE (jp_i2) ; itype = NF90_SHORT 771 CASE (jp_i1) ; itype = NF90_BYTE 765 772 CASE DEFAULT ; CALL ctl_stop( TRIM(clinfo)//' unknown variable type' ) 766 773 END SELECT -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90
r10357 r10358 574 574 INTEGER, INTENT(in ), OPTIONAL :: kcom 575 575 INTEGER :: ierror, ilocalcomm 576 LOGICAL, SAVE :: ll_switch 576 LOGICAL, SAVE :: ll_switch , lllast 577 577 INTEGER, SAVE :: ireq = -1 578 578 !!---------------------------------------------------------------------- 579 579 ilocalcomm = mpi_comm_oce 580 IF( PRESENT(kcom) ) ilocalcomm = kcom 580 IF( PRESENT( kcom) ) ilocalcomm = kcom 581 lllast = .FALSE. 582 IF( PRESENT(ldlast) ) lllast = ldlast 581 583 582 584 IF ( ireq /= -1 ) THEN ! get ld_switch(2) from ll_switch (from previous call) … … 586 588 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 587 589 ENDIF 588 IF( .NOT. l dlast ) & ! send ll_switch to be received on next call590 IF( .NOT. lllast ) & ! send ll_switch to be received on next call 589 591 CALL mpi_iallreduce( ld_switch(1), ll_switch, 1, MPI_LOGICAL, mpi_lor, ilocalcomm, ireq, ierror ) 590 592 … … 751 753 752 754 753 SUBROUTINE mppstop( ldfinal )755 SUBROUTINE mppstop( ldfinal, ld_force_abort ) 754 756 !!---------------------------------------------------------------------- 755 757 !! *** routine mppstop *** … … 759 761 !!---------------------------------------------------------------------- 760 762 LOGICAL, OPTIONAL, INTENT(in) :: ldfinal ! source process number 761 LOGICAL :: llfinal 763 LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort ! source process number 764 LOGICAL :: llfinal, ll_force_abort 762 765 INTEGER :: info 763 766 !!---------------------------------------------------------------------- 764 !765 CALL mppsync766 CALL mpi_finalize( info )767 767 llfinal = .FALSE. 768 768 IF( PRESENT(ldfinal) ) llfinal = ldfinal 769 ll_force_abort = .FALSE. 770 IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort 771 ! 772 IF(ll_force_abort) THEN 773 CALL mpi_abort( MPI_COMM_WORLD ) 774 ELSE 775 CALL mppsync 776 CALL mpi_finalize( info ) 777 ENDIF 769 778 IF( .NOT. llfinal ) STOP 123456 770 779 ! … … 1638 1647 END SUBROUTINE mpp_ilor 1639 1648 1640 SUBROUTINE mppstop 1649 SUBROUTINE mppstop( ldfinal, ld_force_abort ) 1650 LOGICAL, OPTIONAL, INTENT(in) :: ldfinal ! source process number 1651 LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort ! source process number 1641 1652 STOP ! non MPP case, just stop the run 1642 1653 END SUBROUTINE mppstop … … 1766 1777 iost=0 1767 1778 IF( cdacce(1:6) == 'DIRECT' ) THEN 1768 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost ) 1779 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh , ERR=100, IOSTAT=iost ) 1780 ELSE IF( cdstat(1:6) == 'APPEND' ) THEN 1781 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS='UNKNOWN', POSITION='APPEND', ERR=100, IOSTAT=iost ) 1769 1782 ELSE 1770 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost )1771 ENDIF 1772 IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) & 1773 & OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost ) ! for windows1783 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost ) 1784 ENDIF 1785 IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) & ! for windows 1786 & OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost ) 1774 1787 IF( iost == 0 ) THEN 1775 1788 IF(ldwp) THEN 1776 WRITE(kout,*) ' file : ', clfile,' open ok'1789 WRITE(kout,*) ' file : ', TRIM(clfile),' open ok' 1777 1790 WRITE(kout,*) ' unit = ', knum 1778 1791 WRITE(kout,*) ' status = ', cdstat … … 1786 1799 IF(ldwp) THEN 1787 1800 WRITE(kout,*) 1788 WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile1801 WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 1789 1802 WRITE(kout,*) ' ======= === ' 1790 1803 WRITE(kout,*) ' unit = ', knum … … 1797 1810 ELSE !!! Force writing to make sure we get the information - at least once - in this violent STOP!! 1798 1811 WRITE(*,*) 1799 WRITE(*,*) ' ===>>>> : bad opening file: ', clfile1812 WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile) 1800 1813 WRITE(*,*) ' ======= === ' 1801 1814 WRITE(*,*) ' unit = ', knum -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/stpctl.F90
r10314 r10358 33 33 34 34 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, istatus 35 LOGICAL :: lsomeoce 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 61 INTEGER, INTENT(inout) :: kindic ! error indicator 61 62 !! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 INTEGER :: ih(2) ! local integers 64 INTEGER :: iu(3) ! - - 65 INTEGER :: is1(3) ! - - 66 INTEGER :: is2(3) ! - - 67 REAL(wp) :: zzz ! local real 68 INTEGER , DIMENSION(3) :: ilocu, ilocs1, ilocs2 69 INTEGER , DIMENSION(2) :: iloch 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 65 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 66 REAL(wp) :: zzz ! local real 70 67 REAL(wp), DIMENSION(5) :: zmax 71 68 CHARACTER(len=20) :: clname … … 77 74 WRITE(numout,*) '~~~~~~~' 78 75 ! ! open time.step file 79 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )76 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 77 ! ! open run.stat file 81 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 82 83 IF( lwm ) THEN 78 IF( ln_ctl .AND. lwm ) THEN 79 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 84 80 clname = 'run.stat.nc' 85 81 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) … … 92 88 istatus = NF90_ENDDEF(idrun) 93 89 ENDIF 94 95 90 ENDIF 91 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 96 92 ! 97 IF(lw p) THEN !== current time step ==! ("time.step" file)93 IF(lwm) THEN !== current time step ==! ("time.step" file) 98 94 WRITE ( numstp, '(1x, i8)' ) kt 99 95 REWIND( numstp ) … … 111 107 zmax(5) = REAL( nstop , wp ) ! stop indicator 112 108 ! 113 IF( lk_mpp ) THEN 114 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 115 ! 109 IF( lk_mpp .AND. ln_ctl ) THEN 110 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 116 111 nstop = NINT( zmax(5) ) ! nstop indicator sheared among all local domains 117 112 ENDIF 118 ! 119 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 120 WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ', zmax(1), ' |U| max: ', zmax(2), & 121 & ' S min: ' , - zmax(3), ' S max: ', zmax(4) 122 ENDIF 123 ! 124 IF ( zmax(1) > 15._wp .OR. & ! too large sea surface height ( > 15 m ) 125 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 126 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 127 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 128 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 129 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 130 IF( lk_mpp ) THEN 131 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, ih ) 132 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iu ) 133 CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 134 CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 135 ELSE 136 iloch = MINLOC( ABS( sshn(:,:) ) ) 137 ilocu = MAXLOC( ABS( un (:,:,:) ) ) 138 ilocs1 = MINLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 139 ilocs2 = MAXLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 140 ih(1) = iloch (1) + nimpp - 1 ; ih(2) = iloch (2) + njmpp - 1 141 iu(1) = ilocu (1) + nimpp - 1 ; iu(2) = ilocu (2) + njmpp - 1 ; iu(3) = ilocu (3) 142 is1(1) = ilocs1(1) + nimpp - 1 ; is1(2) = ilocs1(2) + njmpp - 1 ; is1(3) = ilocs1(3) 143 is2(1) = ilocs2(1) + nimpp - 1 ; is2(2) = ilocs2(2) + njmpp - 1 ; is2(3) = ilocs2(3) 144 ENDIF 145 IF(lwp) THEN 146 WRITE(numout,cform_err) 147 WRITE(numout,*) ' stp_ctl: |ssh| > 10 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 148 WRITE(numout,*) ' ======= ' 149 WRITE(numout,9100) kt, zmax(1), ih(1) , ih(2) 150 WRITE(numout,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 151 WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 152 WRITE(numout,9400) kt, zmax(4), is2(1), is2(2), is2(3) 153 WRITE(numout,*) 154 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 155 ENDIF 156 kindic = -3 157 ! 158 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 159 CALL dia_wri_state( 'output.abort', kt ) ! create an output.abort file 160 ! 161 ENDIF 162 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 163 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 164 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 165 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 166 ! 167 ! !== run statistics ==! ("run.stat" file) 168 IF(lwp) WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 169 IF( lwm ) THEN 113 ! !== run statistics ==! ("run.stat" files) 114 IF( ln_ctl .AND. lwm ) THEN 115 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 170 116 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 171 117 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) … … 175 121 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 176 122 END IF 123 ! !== error handling ==! 124 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 125 & zmax(1) > 15._wp .OR. & ! too large sea surface height ( > 15 m ) 126 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 127 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 128 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 129 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 130 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 131 IF( lk_mpp .AND. ln_ctl ) THEN 132 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, ih ) 133 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iu ) 134 CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 135 CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 136 ELSE 137 ih(:) = MAXLOC( ABS( sshn(:,:) ) ) + (/ nimpp - 1, njmpp - 1 /) 138 iu(:) = MAXLOC( ABS( un (:,:,:) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 139 is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 140 is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 141 ENDIF 142 IF( numout == 6 ) & ! force to open ocean.output file 143 CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 144 145 WRITE(numout,cform_err) 146 WRITE(numout,*) ' stp_ctl: |ssh| > 10 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 147 WRITE(numout,*) ' ======= ' 148 IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 149 WRITE(numout,9100) kt, zmax(1), ih(1) , ih(2) 150 WRITE(numout,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 151 WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 152 WRITE(numout,9400) kt, zmax(4), is2(1), is2(2), is2(3) 153 WRITE(numout,*) 154 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 155 156 CALL dia_wri_state( 'output.abort' ) ! create an output.abort file 157 158 IF( ln_ctl ) THEN 159 kindic = -3 160 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 161 ELSE 162 CALL ctl_stop() 163 CALL mppstop(ld_force_abort = .true.) 164 ENDIF 165 ! 166 ENDIF 177 167 ! 168 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 169 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 170 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 171 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 178 172 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 179 173 ! -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OFF/nemogcm.F90
r10345 r10358 481 481 !!---------------------------------------------------------------------- 482 482 ! 483 IF( kt == nit000 .AND. lw p) THEN483 IF( kt == nit000 .AND. lwm ) THEN 484 484 WRITE(numout,*) 485 485 WRITE(numout,*) 'stp_ctl : time-stepping control' … … 489 489 ENDIF 490 490 ! 491 IF(lw p) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp492 IF(lw p) REWIND( numstp ) ! --------------------------491 IF(lwm) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 492 IF(lwm) REWIND( numstp ) ! -------------------------- 493 493 ! 494 494 END SUBROUTINE stp_ctl -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/diawri.F90
r10297 r10358 39 39 USE ioipsl 40 40 #if defined key_si3 41 USE ice 41 42 USE icewri 42 43 #endif … … 93 94 ! Output the initial state and forcings 94 95 IF( ninist == 1 ) THEN 95 CALL dia_wri_state( 'output.init' , kt)96 CALL dia_wri_state( 'output.init' ) 96 97 ninist = 0 97 98 ENDIF … … 142 143 ! Output the initial state and forcings 143 144 IF( ninist == 1 ) THEN 144 CALL dia_wri_state( 'output.init' , kt)145 CALL dia_wri_state( 'output.init' ) 145 146 ninist = 0 146 147 ENDIF … … 329 330 #endif 330 331 331 SUBROUTINE dia_wri_state( cdfile_name , kt)332 SUBROUTINE dia_wri_state( cdfile_name ) 332 333 !!--------------------------------------------------------------------- 333 334 !! *** ROUTINE dia_wri_state *** … … 343 344 !!---------------------------------------------------------------------- 344 345 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 345 INTEGER , INTENT( in ) :: kt ! ocean time-step index 346 !! 347 CHARACTER (len=32) :: clname 348 CHARACTER (len=40) :: clop 349 INTEGER :: id_i , nz_i, nh_i 350 INTEGER, DIMENSION(1) :: idex ! local workspace 351 REAL(wp) :: zsto, zout, zmax, zjulian 346 !! 347 INTEGER :: inum 352 348 !!---------------------------------------------------------------------- 353 349 ! 354 IF( ln_timing ) CALL timing_start('dia_wri_state')355 356 ! 0. Initialisation357 ! -----------------358 359 ! Define name, frequency of output and means360 clname = cdfile_name361 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)362 zsto = rdt363 clop = "inst(x)" ! no use of the mask value (require less cpu time)364 zout = rdt365 zmax = ( nitend - nit000 + 1 ) * rdt366 367 350 IF(lwp) WRITE(numout,*) 368 351 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 369 352 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 370 IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' 371 372 373 ! 1. Define NETCDF files and fields at beginning of first time step 374 ! ----------------------------------------------------------------- 375 376 ! Compute julian date from starting date of the run 377 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis 378 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 379 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 380 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 381 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 382 "m", jpk, gdept_1d, nz_i, "down") 383 384 ! Declare all the output fields as NetCDF variables 385 386 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 387 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 388 CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux 389 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 390 CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux 391 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 392 CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i 393 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 394 CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress 395 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 396 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 397 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 353 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 398 354 399 355 #if defined key_si3 400 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + lim but no-ice in child grid 401 CALL ice_wri_state( kt, id_i, nh_i ) 402 ENDIF 356 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 403 357 #else 404 CALL histend( id_i, snc4chunks=snc4set ) 405 #endif 406 407 ! 2. Start writing data 408 ! --------------------- 409 ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 410 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 411 ! donne le nombre d'elements, et idex la liste des indices a sortir 412 idex(1) = 1 ! init to avoid compil warning 413 414 ! Write all fields on T grid 415 CALL histwrite( id_i, "sowaflup", kt, emp , jpi*jpj , idex ) ! freshwater budget 416 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 417 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 418 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 419 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 420 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 421 422 ! 3. Close the file 423 ! ----------------- 424 CALL histclo( id_i ) 425 #if ! defined key_iomput 426 IF( ninist /= 1 ) THEN 427 CALL histclo( nid_T ) 428 CALL histclo( nid_U ) 429 CALL histclo( nid_V ) 430 ENDIF 431 #endif 432 ! 433 IF( ln_timing ) CALL timing_stop('dia_wri_state') 358 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 359 #endif 360 361 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 362 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 363 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 364 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 365 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 366 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 367 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 368 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux 369 CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux 370 CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction 371 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 372 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 373 374 #if defined key_si3 375 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 376 CALL ice_wri_state( inum ) 377 ENDIF 378 #endif 379 ! 380 CALL iom_close( inum ) 434 381 ! 435 382 END SUBROUTINE dia_wri_state -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/step.F90
r10068 r10358 121 121 IF( indic < 0 ) THEN 122 122 CALL ctl_stop( 'step: indic < 0' ) 123 CALL dia_wri_state( 'output.abort' , kstp)123 CALL dia_wri_state( 'output.abort' ) 124 124 ENDIF 125 125 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/SAS/stpctl.F90
r10314 r10358 32 32 33 33 INTEGER :: idrun, idtime, idssh, idu, ids, istatus 34 LOGICAL :: lsomeoce 34 35 !!---------------------------------------------------------------------- 35 36 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 57 58 !! 58 59 REAL(wp), DIMENSION(3) :: zmax 60 CHARACTER(len=20) :: clname 59 61 !!---------------------------------------------------------------------- 60 62 … … 64 66 WRITE(numout,*) '~~~~~~~' 65 67 ! ! open time.step file 66 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )68 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 67 69 ! ! open run.stat file 68 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 69 70 IF( lwm ) THEN 70 IF( ln_ctl .AND. lwm ) THEN 71 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 72 clname = 'run.stat.nc' 73 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 71 74 istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 72 75 istatus = NF90_DEF_DIM( idrun, 'time' , NF90_UNLIMITED, idtime ) … … 76 79 istatus = NF90_ENDDEF(idrun) 77 80 ENDIF 78 79 81 ENDIF 82 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 80 83 ! 81 IF(lw p) THEN !== current time step ==! ("time.step" file)84 IF(lwm) THEN !== current time step ==! ("time.step" file) 82 85 WRITE ( numstp, '(1x, i8)' ) kt 83 86 REWIND( numstp ) 84 87 ENDIF 85 88 ! !== test of extrema ==! 86 zmax(1) = MAXVAL( vt_i (:,:) ) ! max ice thickness 87 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) ) ! max ice velocity (zonal only) 88 zmax(3) = MAXVAL( -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp ) ! min ice temperature 89 ! 90 IF( lk_mpp ) CALL mpp_max( "stpctl", zmax ) ! max over the global domain 91 ! 92 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 93 WRITE(numout,*) ' ==>> time-step= ', kt, ' vt_i max: ', zmax(1), ' |u_ice| max: ', zmax(2), ' tm_i min: ', -zmax(3) 94 ENDIF 95 89 IF( ln_ctl ) THEN ! must be done by all processes because of the mpp_max 90 zmax(1) = MAXVAL( vt_i (:,:) ) ! max ice thickness 91 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) ) ! max ice velocity (zonal only) 92 zmax(3) = MAXVAL( -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp ) ! min ice temperature 93 IF( lk_mpp ) CALL mpp_max( "stpctl", zmax ) ! max over the global domain 94 END IF 96 95 ! !== run statistics ==! ("run.stat" file) 97 IF( lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3)98 IF( lwm ) THEN96 IF( ln_ctl .AND. lwm ) THEN 97 IF(lwp) WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 99 98 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 100 99 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) … … 104 103 END IF 105 104 ! 106 9 400 FORMAT(' it :', i8, ' vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16)105 9500 FORMAT(' it :', i8, ' vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 107 106 ! 108 107 END SUBROUTINE stp_ctl -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/BENCH/MY_SRC/diawri.F90
r10179 r10358 52 52 53 53 #if defined key_si3 54 USE ice 54 55 USE icewri 55 56 #endif … … 119 120 ! Output the initial state and forcings 120 121 IF( ninist == 1 ) THEN 121 CALL dia_wri_state( 'output.init' , kt)122 CALL dia_wri_state( 'output.init' ) 122 123 ninist = 0 123 124 ENDIF … … 410 411 411 412 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 412 CALL dia_wri_state( 'output.init' , kt)413 CALL dia_wri_state( 'output.init' ) 413 414 ninist = 0 414 415 ENDIF … … 418 419 #endif 419 420 420 SUBROUTINE dia_wri_state( cdfile_name , kt)421 SUBROUTINE dia_wri_state( cdfile_name ) 421 422 !!--------------------------------------------------------------------- 422 423 !! *** ROUTINE dia_wri_state *** … … 432 433 !!---------------------------------------------------------------------- 433 434 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 434 INTEGER , INTENT( in ) :: kt ! ocean time-step index 435 !! 436 CHARACTER (len=32) :: clname 437 CHARACTER (len=40) :: clop 438 INTEGER :: id_i , nz_i, nh_i 439 INTEGER, DIMENSION(1) :: idex ! local workspace 440 REAL(wp) :: zsto, zout, zmax, zjulian 435 !! 436 INTEGER :: inum 441 437 !!---------------------------------------------------------------------- 442 438 ! 443 ! 0. Initialisation444 ! -----------------445 446 ! Define name, frequency of output and means447 clname = cdfile_name448 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)449 zsto = rdt450 clop = "inst(x)" ! no use of the mask value (require less cpu time)451 zout = rdt452 zmax = ( nitend - nit000 + 1 ) * rdt453 454 439 IF(lwp) WRITE(numout,*) 455 440 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 456 441 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 457 IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' 458 459 460 ! 1. Define NETCDF files and fields at beginning of first time step 461 ! ----------------------------------------------------------------- 462 463 ! Compute julian date from starting date of the run 464 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis 465 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 466 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 467 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 468 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 469 "m", jpk, gdept_1d, nz_i, "down") 470 471 ! Declare all the output fields as NetCDF variables 472 473 CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity 474 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 475 CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature 476 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 477 CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh 478 & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) 479 CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current 480 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 481 CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current 482 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 483 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 484 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 485 ! 442 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 443 444 #if defined key_si3 445 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 446 #else 447 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 448 #endif 449 450 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 451 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 452 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 453 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 454 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 455 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 486 456 IF( ALLOCATED(ahtu) ) THEN 487 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 488 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 489 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 490 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 491 ENDIF 492 IF( ALLOCATED(ahmt) ) THEN 493 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 494 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 495 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 496 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 497 ENDIF 498 ! 499 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 500 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 501 CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux 502 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 503 CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux 504 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 505 CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i 506 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 507 CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress 508 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 509 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 510 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 511 IF( .NOT.ln_linssh ) THEN 512 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 513 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 514 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 515 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 516 ENDIF 517 ! 457 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point 458 CALL iom_rstput( 0, 0, inum, 'ahtv', ahtv ) ! aht at v-point 459 ENDIF 460 IF( ALLOCATED(ahmt) ) THEN 461 CALL iom_rstput( 0, 0, inum, 'ahmt', ahmt ) ! ahmt at u-point 462 CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point 463 ENDIF 464 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 465 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux 466 CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux 467 CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction 468 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 469 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 470 IF( .NOT.ln_linssh ) THEN 471 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n ) ! T-cell depth 472 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n ) ! T-cell thickness 473 END IF 518 474 IF( ln_wave .AND. ln_sdw ) THEN 519 CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal" , "m/s" , & ! StokesDrift zonal current 520 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 521 CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid" , "m/s" , & ! StokesDrift meridonal current 522 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 523 CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert" , "m/s" , & ! StokesDrift vertical current 524 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 525 ENDIF 526 475 CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity 476 CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd ) ! now StokesDrift j-velocity 477 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 478 ENDIF 479 527 480 #if defined key_si3 528 481 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 529 CALL ice_wri_state( kt, id_i, nh_i ) 530 ENDIF 531 #else 532 CALL histend( id_i, snc4chunks=snc4set ) 482 CALL ice_wri_state( inum ) 483 ENDIF 533 484 #endif 534 535 ! 2. Start writing data 536 ! --------------------- 537 ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 538 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 539 ! donne le nombre d'elements, et idex la liste des indices a sortir 540 idex(1) = 1 ! init to avoid compil warning 541 542 ! Write all fields on T grid 543 CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature 544 CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity 545 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height 546 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity 547 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 548 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 549 ! 550 IF( ALLOCATED(ahtu) ) THEN 551 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 552 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 553 ENDIF 554 IF( ALLOCATED(ahmt) ) THEN 555 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 556 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 557 ENDIF 558 ! 559 CALL histwrite( id_i, "sowaflup", kt, emp - rnf , jpi*jpj , idex ) ! freshwater budget 560 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 561 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 562 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 563 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 564 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 565 566 IF( .NOT.ln_linssh ) THEN 567 CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 568 CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )! T-cell thickness 569 END IF 570 571 IF( ln_wave .AND. ln_sdw ) THEN 572 CALL histwrite( id_i, "sdzocrtx", kt, usd , jpi*jpj*jpk, idex) ! now StokesDrift i-velocity 573 CALL histwrite( id_i, "sdmecrty", kt, vsd , jpi*jpj*jpk, idex) ! now StokesDrift j-velocity 574 CALL histwrite( id_i, "sdvecrtz", kt, wsd , jpi*jpj*jpk, idex) ! now StokesDrift k-velocity 575 ENDIF 576 577 ! 3. Close the file 578 ! ----------------- 579 CALL histclo( id_i ) 580 #if ! defined key_iomput 581 IF( ninist /= 1 ) THEN 582 CALL histclo( nid_T ) 583 CALL histclo( nid_U ) 584 CALL histclo( nid_V ) 585 CALL histclo( nid_W ) 586 ENDIF 587 #endif 485 ! 486 CALL iom_close( inum ) 588 487 ! 589 488 END SUBROUTINE dia_wri_state -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/diawri.F90
r10297 r10358 52 52 53 53 #if defined key_si3 54 USE ice 54 55 USE icewri 55 56 #endif … … 89 90 !! 'key_iomput' use IOM library 90 91 !!---------------------------------------------------------------------- 91 92 92 INTEGER FUNCTION dia_wri_alloc() 93 93 ! … … 96 96 END FUNCTION dia_wri_alloc 97 97 98 98 99 99 SUBROUTINE dia_wri( kt ) 100 100 !!--------------------------------------------------------------------- … … 123 123 ! Output the initial state and forcings 124 124 IF( ninist == 1 ) THEN 125 CALL dia_wri_state( 'output.init' , kt)125 CALL dia_wri_state( 'output.init' ) 126 126 ninist = 0 127 127 ENDIF … … 129 129 ! Output of initial vertical scale factor 130 130 CALL iom_put("e3t_0", e3t_0(:,:,:) ) 131 CALL iom_put("e3u_0", e3 t_0(:,:,:) )132 CALL iom_put("e3v_0", e3 t_0(:,:,:) )131 CALL iom_put("e3u_0", e3u_0(:,:,:) ) 132 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 133 133 ! 134 134 CALL iom_put( "e3t" , e3t_n(:,:,:) ) … … 505 505 !! Default option use IOIPSL library 506 506 !!---------------------------------------------------------------------- 507 507 508 508 INTEGER FUNCTION dia_wri_alloc() 509 509 !!---------------------------------------------------------------------- … … 519 519 ! 520 520 END FUNCTION dia_wri_alloc 521 522 521 522 523 523 SUBROUTINE dia_wri( kt ) 524 524 !!--------------------------------------------------------------------- … … 551 551 ! 552 552 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 553 CALL dia_wri_state( 'output.init' , kt)553 CALL dia_wri_state( 'output.init' ) 554 554 ninist = 0 555 555 ENDIF … … 974 974 #endif 975 975 976 SUBROUTINE dia_wri_state( cdfile_name , kt)976 SUBROUTINE dia_wri_state( cdfile_name ) 977 977 !!--------------------------------------------------------------------- 978 978 !! *** ROUTINE dia_wri_state *** … … 988 988 !!---------------------------------------------------------------------- 989 989 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 990 INTEGER , INTENT( in ) :: kt ! ocean time-step index 991 !! 992 CHARACTER (len=32) :: clname 993 CHARACTER (len=40) :: clop 994 INTEGER :: id_i , nz_i, nh_i 995 INTEGER, DIMENSION(1) :: idex ! local workspace 996 REAL(wp) :: zsto, zout, zmax, zjulian 990 !! 991 INTEGER :: inum 997 992 !!---------------------------------------------------------------------- 998 993 ! 999 ! 0. Initialisation1000 ! -----------------1001 1002 ! Define name, frequency of output and means1003 clname = cdfile_name1004 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)1005 zsto = rdt1006 clop = "inst(x)" ! no use of the mask value (require less cpu time)1007 zout = rdt1008 zmax = ( nitend - nit000 + 1 ) * rdt1009 1010 994 IF(lwp) WRITE(numout,*) 1011 995 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 1012 996 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 1013 IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' 1014 1015 1016 ! 1. Define NETCDF files and fields at beginning of first time step 1017 ! ----------------------------------------------------------------- 1018 1019 ! Compute julian date from starting date of the run 1020 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis 1021 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 1022 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 1023 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 1024 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 1025 "m", jpk, gdept_1d, nz_i, "down") 1026 1027 ! Declare all the output fields as NetCDF variables 1028 1029 CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity 1030 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1031 CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature 1032 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1033 CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh 1034 & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) 1035 CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current 1036 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1037 CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current 1038 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1039 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 1040 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1041 ! 997 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 998 999 #if defined key_si3 1000 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 1001 #else 1002 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kiolib = jprstlib ) 1003 #endif 1004 1005 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 1006 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 1007 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 1008 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 1009 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 1010 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 1042 1011 IF( ALLOCATED(ahtu) ) THEN 1043 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 1044 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1045 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 1046 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1047 ENDIF 1048 IF( ALLOCATED(ahmt) ) THEN 1049 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 1050 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1051 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 1052 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1053 ENDIF 1054 ! 1055 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 1056 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1057 CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux 1058 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1059 CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux 1060 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1061 CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i 1062 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1063 CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress 1064 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1065 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 1066 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 1067 IF( .NOT.ln_linssh ) THEN 1068 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 1069 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1070 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 1071 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1072 ENDIF 1073 ! 1012 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point 1013 CALL iom_rstput( 0, 0, inum, 'ahtv', ahtv ) ! aht at v-point 1014 ENDIF 1015 IF( ALLOCATED(ahmt) ) THEN 1016 CALL iom_rstput( 0, 0, inum, 'ahmt', ahmt ) ! ahmt at u-point 1017 CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point 1018 ENDIF 1019 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 1020 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux 1021 CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux 1022 CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction 1023 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 1024 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 1025 IF( .NOT.ln_linssh ) THEN 1026 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n ) ! T-cell depth 1027 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n ) ! T-cell thickness 1028 END IF 1074 1029 IF( ln_wave .AND. ln_sdw ) THEN 1075 CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal" , "m/s" , & ! StokesDrift zonal current 1076 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1077 CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid" , "m/s" , & ! StokesDrift meridonal current 1078 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1079 CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert" , "m/s" , & ! StokesDrift vertical current 1080 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1081 ENDIF 1082 1030 CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity 1031 CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd ) ! now StokesDrift j-velocity 1032 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 1033 ENDIF 1034 1083 1035 #if defined key_si3 1084 1036 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 1085 CALL ice_wri_state( kt, id_i, nh_i ) 1086 ENDIF 1087 #else 1088 CALL histend( id_i, snc4chunks=snc4set ) 1037 CALL ice_wri_state( inum ) 1038 ENDIF 1089 1039 #endif 1090 1091 ! 2. Start writing data 1092 ! --------------------- 1093 ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 1094 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 1095 ! donne le nombre d'elements, et idex la liste des indices a sortir 1096 idex(1) = 1 ! init to avoid compil warning 1097 1098 ! Write all fields on T grid 1099 CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature 1100 CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity 1101 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height 1102 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity 1103 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 1104 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 1105 ! 1106 IF( ALLOCATED(ahtu) ) THEN 1107 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 1108 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 1109 ENDIF 1110 IF( ALLOCATED(ahmt) ) THEN 1111 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 1112 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 1113 ENDIF 1114 ! 1115 CALL histwrite( id_i, "sowaflup", kt, emp - rnf , jpi*jpj , idex ) ! freshwater budget 1116 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 1117 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 1118 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 1119 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 1120 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 1121 1122 IF( .NOT.ln_linssh ) THEN 1123 CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 1124 CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )! T-cell thickness 1125 END IF 1126 1127 IF( ln_wave .AND. ln_sdw ) THEN 1128 CALL histwrite( id_i, "sdzocrtx", kt, usd , jpi*jpj*jpk, idex) ! now StokesDrift i-velocity 1129 CALL histwrite( id_i, "sdmecrty", kt, vsd , jpi*jpj*jpk, idex) ! now StokesDrift j-velocity 1130 CALL histwrite( id_i, "sdvecrtz", kt, wsd , jpi*jpj*jpk, idex) ! now StokesDrift k-velocity 1131 ENDIF 1132 1133 ! 3. Close the file 1134 ! ----------------- 1135 CALL histclo( id_i ) 1136 #if ! defined key_iomput 1137 IF( ninist /= 1 ) THEN 1138 CALL histclo( nid_T ) 1139 CALL histclo( nid_U ) 1140 CALL histclo( nid_V ) 1141 CALL histclo( nid_W ) 1142 ENDIF 1143 #endif 1040 ! 1041 CALL iom_close( inum ) 1144 1042 ! 1145 1043 END SUBROUTINE dia_wri_state -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/stpctl.F90
r10314 r10358 32 32 PUBLIC stp_ctl ! routine called by step.F90 33 33 34 INTEGER :: idrun, idtime, idssh, idu, ids, istatus 34 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, istatus 35 LOGICAL :: lsomeoce 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 61 INTEGER, INTENT(inout) :: kindic ! error indicator 61 62 !! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 INTEGER :: iih, ijh ! local integers 64 INTEGER :: iiu, iju, iku ! - - 65 INTEGER :: iis, ijs, iks ! - - 66 REAL(wp) :: zzz ! local real 67 INTEGER , DIMENSION(3) :: ilocu, ilocs 68 INTEGER , DIMENSION(2) :: iloch 69 REAL(wp), DIMENSION(4) :: zmax 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 65 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 66 REAL(wp) :: zzz ! local real 67 REAL(wp), DIMENSION(5) :: zmax 68 CHARACTER(len=20) :: clname 70 69 !!---------------------------------------------------------------------- 71 70 ! … … 75 74 WRITE(numout,*) '~~~~~~~' 76 75 ! ! open time.step file 77 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )76 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 78 77 ! ! open run.stat file 79 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 81 IF( lwm ) THEN 82 istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 78 IF( ln_ctl .AND. lwm ) THEN 79 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 clname = 'run.stat.nc' 81 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 82 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 83 83 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 84 84 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 85 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 85 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 86 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 87 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 86 88 istatus = NF90_ENDDEF(idrun) 87 89 ENDIF 88 89 90 ENDIF 91 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 90 92 ! 91 IF(lw p) THEN !== current time step ==! ("time.step" file)93 IF(lwm) THEN !== current time step ==! ("time.step" file) 92 94 WRITE ( numstp, '(1x, i8)' ) kt 93 95 REWIND( numstp ) … … 101 103 ENDIF 102 104 zmax(2) = MAXVAL( ABS( un(:,:,:) ) ) ! velocity max (zonal only) 103 !zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max104 zmax( 3) = 0.0_wp105 zmax( 4) = REAL( nstop , wp ) ! stop indicator105 zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 106 zmax(4) = MAXVAL( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 107 zmax(5) = REAL( nstop , wp ) ! stop indicator 106 108 ! 107 IF( lk_mpp ) THEN 108 CALL mpp_max_multiple( zmax(:), 4 ) ! max over the global domain 109 ! 110 nstop = INT( zmax(4) ) ! nstop indicator sheared among all local domains 109 IF( lk_mpp .AND. ln_ctl ) THEN 110 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 111 nstop = NINT( zmax(5) ) ! nstop indicator sheared among all local domains 111 112 ENDIF 112 ! 113 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 114 WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ', zmax(1), ' |U| max: ', zmax(2) 115 ENDIF 116 ! 117 IF ( zmax(1) > 50._wp .OR. & ! too large sea surface height ( > 10 m) 118 & zmax(2) > 20._wp .OR. & ! too large velocity ( > 10 m/s) 119 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 120 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 121 IF( lk_mpp ) THEN 122 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, iih, ijh ) 123 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iiu, iju, iku ) 124 ! CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, iis, ijs, iks ) 125 ELSE 126 iloch = MINLOC( ABS( sshn(:,:) ) ) 127 ilocu = MAXLOC( ABS( un (:,:,:) ) ) 128 ! ilocs = MINLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 129 iih = iloch(1) + nimpp - 1 ; ijh = iloch(2) + njmpp - 1 130 iiu = ilocu(1) + nimpp - 1 ; iju = ilocu(2) + njmpp - 1 ; iku = ilocu(3) 131 ! iis = ilocs(1) + nimpp - 1 ; ijs = ilocs(2) + njmpp - 1 ; iks = ilocu(3) 132 ENDIF 133 IF(lwp) THEN 134 WRITE(numout,cform_err) 135 WRITE(numout,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or NaN encounter in the tests' 136 WRITE(numout,*) ' ======= ' 137 WRITE(numout,9100) kt, zmax(1), iih, ijh 138 WRITE(numout,9200) kt, zmax(2), iiu, iju, iku 139 !!$ WRITE(numout,9300) kt, - zmax(3), iis, ijs, iks 140 WRITE(numout,*) 141 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 142 ENDIF 143 kindic = -3 144 ! 145 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 146 CALL dia_wri_state( 'output.abort', kt ) ! create an output.abort file 147 ! 148 ENDIF 149 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 150 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 151 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j : ',2i5) 152 ! 153 ! !== run statistics ==! ("run.stat" file) 154 ! IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 155 IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2) 156 IF( lwm ) THEN 113 ! !== run statistics ==! ("run.stat" files) 114 IF( ln_ctl .AND. lwm ) THEN 115 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 157 116 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 158 117 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) 159 ! istatus = NF90_PUT_VAR( idrun, ids, (/-zmax(3)/), (/kt/), (/1/) ) 118 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) ) 119 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) ) 160 120 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 161 121 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 162 122 END IF 123 ! !== error handling ==! 124 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 125 & zmax(1) > 50._wp .OR. & ! too large sea surface height ( > 50 m ) 126 & zmax(2) > 20._wp .OR. & ! too large velocity ( > 20 m/s) 127 & zmax(3) >= 100._wp .OR. & ! too small sea surface salinity ( < -100 ) 128 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 129 & zmax(4) < -100._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 130 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 131 IF( lk_mpp .AND. ln_ctl ) THEN 132 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, ih ) 133 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iu ) 134 CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 135 CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 136 ELSE 137 ih(:) = MAXLOC( ABS( sshn(:,:) ) ) + (/ nimpp - 1, njmpp - 1 /) 138 iu(:) = MAXLOC( ABS( un (:,:,:) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 139 is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 140 is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 141 ENDIF 142 IF( numout == 6 ) & ! force to open ocean.output file 143 CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 144 145 WRITE(numout,cform_err) 146 WRITE(numout,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or S <= -100 or S >= 100 or NaN encounter in the tests' 147 WRITE(numout,*) ' ======= ' 148 IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 149 WRITE(numout,9100) kt, zmax(1), ih(1) , ih(2) 150 WRITE(numout,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 151 WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 152 WRITE(numout,9400) kt, zmax(4), is2(1), is2(2), is2(3) 153 WRITE(numout,*) 154 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 155 156 CALL dia_wri_state( 'output.abort' ) ! create an output.abort file 157 158 IF( ln_ctl ) THEN 159 kindic = -3 160 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 161 ELSE 162 CALL ctl_stop() 163 CALL mppstop(ld_force_abort = .true.) 164 ENDIF 165 ! 166 ENDIF 163 167 ! 164 !9400 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16) 165 9400 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16) 168 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 169 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 170 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 171 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 172 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 166 173 ! 167 174 END SUBROUTINE stp_ctl
Note: See TracChangeset
for help on using the changeset viewer.