Changeset 10425 for NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/diawri.F90
r10074 r10425 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(:,:,:) ) … … 185 185 END DO 186 186 END DO 187 CALL lbc_lnk( z2d, 'T', 1. )187 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 188 188 CALL iom_put( "taubot", z2d ) 189 189 ENDIF … … 244 244 END DO 245 245 END DO 246 CALL lbc_lnk( z3d, 'T', 1. )246 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 247 247 CALL iom_put( "salgrad2", z3d ) ! square of module of sal gradient 248 248 z3d(:,:,:) = SQRT( z3d(:,:,:) ) … … 260 260 END DO 261 261 END DO 262 CALL lbc_lnk( z2d, 'T', 1. )262 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 263 263 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 264 264 z2d(:,:) = SQRT( z2d(:,:) ) … … 314 314 END DO 315 315 END DO 316 CALL lbc_lnk( z3d, 'T', 1. )316 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 317 317 CALL iom_put( "eken", z3d ) ! kinetic energy 318 318 ENDIF … … 335 335 END DO 336 336 337 CALL lbc_lnk( z3d, 'T', 1. )337 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 338 338 CALL iom_put( "ke", z3d ) ! kinetic energy 339 339 … … 363 363 END DO 364 364 END DO 365 CALL lbc_lnk( z3d, 'F', 1. )365 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 366 366 CALL iom_put( "relvor", z3d ) ! relative vorticity 367 367 … … 387 387 END DO 388 388 END DO 389 CALL lbc_lnk( z3d, 'F', 1. )389 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 390 390 CALL iom_put( "potvor", z3d ) ! potential vorticity 391 391 … … 413 413 END DO 414 414 END DO 415 CALL lbc_lnk( z2d, 'U', -1. )415 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 416 416 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 417 417 ENDIF … … 426 426 END DO 427 427 END DO 428 CALL lbc_lnk( z2d, 'U', -1. )428 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 429 429 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 430 430 ENDIF … … 448 448 END DO 449 449 END DO 450 CALL lbc_lnk( z2d, 'V', -1. )450 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 451 451 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 452 452 ENDIF … … 461 461 END DO 462 462 END DO 463 CALL lbc_lnk( z2d, 'V', -1. )463 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 464 464 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 465 465 ENDIF … … 474 474 END DO 475 475 END DO 476 CALL lbc_lnk( z2d, 'T', -1. )476 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 477 477 CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature 478 478 ENDIF … … 486 486 END DO 487 487 END DO 488 CALL lbc_lnk( z2d, 'T', -1. )488 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 489 489 CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity 490 490 ENDIF … … 505 505 !! Default option use IOIPSL library 506 506 !!---------------------------------------------------------------------- 507 507 508 508 INTEGER FUNCTION dia_wri_alloc() 509 509 !!---------------------------------------------------------------------- … … 516 516 ! 517 517 dia_wri_alloc = MAXVAL(ierr) 518 IF( lk_mpp ) CALL mpp_sum(dia_wri_alloc )518 CALL mpp_sum( 'diawri', dia_wri_alloc ) 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 … … 625 625 !! that routine is called from nemogcm, so do it here immediately before its needed 626 626 ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 627 IF( lk_mpp ) CALL mpp_sum(ierror )627 CALL mpp_sum( 'diawri', ierror ) 628 628 IF( ierror /= 0 ) THEN 629 629 CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') … … 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., kdlev = jpl ) 1001 #else 1002 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 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
Note: See TracChangeset
for help on using the changeset viewer.