Changeset 6736 for branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM
- Timestamp:
- 2016-06-24T09:50:27+02:00 (8 years ago)
- Location:
- branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r3680 r6736 41 41 LOGICAL :: ln_clobber = .FALSE. !: clobber (overwrite) an existing file 42 42 INTEGER :: nn_chunksz = 0 !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 43 LOGICAL :: ln_fse3t_b = .TRUE. !: restart contains fse3t_b 43 44 #if defined key_netcdf4 44 45 !!---------------------------------------------------------------------- … … 80 81 !! was in restart but moved here because of the OFF line... better solution should be found... 81 82 !!---------------------------------------------------------------------- 82 INTEGER :: nitrst !: time step at which restart file should be written 83 LOGICAL :: lrst_oce !: logical to control the oce restart write 84 INTEGER :: numror, numrow !: logical unit for cean restart (read and write) 83 INTEGER :: nitrst !: time step at which restart file should be written 85 84 86 85 !!---------------------------------------------------------------------- -
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3771 r6736 7 7 !! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO 8 8 !! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 10 !! 3.4 ! 2013-04 (J. Harle) added real attribute case 10 11 !!-------------------------------------------------------------------- 11 12 … … 30 31 #if defined key_iomput 31 32 USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers33 33 USE domngb ! ocean space and time domain 34 34 USE phycst ! physical constants 35 35 USE dianam ! build name of file 36 USE xios 36 USE mod_event_client 37 USE mod_attribut 37 38 # endif 38 39 … … 52 53 PRIVATE iom_p1d, iom_p2d, iom_p3d 53 54 #if defined key_iomput 54 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_set_grid_attr 55 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring 55 PRIVATE set_grid 56 56 # endif 57 57 … … 60 60 END INTERFACE 61 61 INTERFACE iom_getatt 62 MODULE PROCEDURE iom_g0d_intatt 62 MODULE PROCEDURE iom_g0d_intatt, iom_g0d_ratt 63 63 END INTERFACE 64 64 INTERFACE iom_rstput … … 70 70 #if defined key_iomput 71 71 INTERFACE iom_setkt 72 MODULE PROCEDURE xios_update_calendar72 MODULE PROCEDURE event__set_timestep 73 73 END INTERFACE 74 74 # endif … … 90 90 !!---------------------------------------------------------------------- 91 91 #if defined key_iomput 92 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 93 CHARACTER(len=19) :: cldate 94 CHARACTER(len=10) :: clname 95 INTEGER :: ji 96 !!---------------------------------------------------------------------- 97 98 clname = "nemo" 99 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 100 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 92 REAL(wp) :: ztmp 93 !!---------------------------------------------------------------------- 94 !if defined key_adam 95 ! REAL(wp) ,DIMENSION( 2833) :: zlon 96 ! REAL(wp) ,DIMENSION( 2833) :: zlat 97 ! include "NA_lons.h90" 98 ! include "NA_lats.h90" 99 !endif 100 ! read the xml file 101 IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 101 102 CALL iom_swap 102 103 103 104 ! calendar parameters 104 105 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 105 CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")106 CASE ( 0) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")107 CASE (30) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")106 CASE ( 1) ; CALL event__set_calendar('gregorian') 107 CASE ( 0) ; CALL event__set_calendar('noleap' ) 108 CASE (30) ; CALL event__set_calendar('360d' ) 108 109 END SELECT 109 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 110 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 110 ztmp = fjulday - adatrj 111 IF( ABS(ztmp - REAL(NINT(ztmp),wp)) < 0.1 / rday ) ztmp = REAL(NINT(ztmp),wp) ! avoid truncation error 112 CALL event__set_time_parameters( nit000 - 1, ztmp, rdt ) 111 113 112 114 ! horizontal grid definition 113 115 CALL set_scalar 114 CALL set_grid( "T", glamt, gphit ) 115 CALL set_grid( "U", glamu, gphiu ) 116 CALL set_grid( "V", glamv, gphiv ) 117 CALL set_grid( "W", glamt, gphit ) 116 #if defined key_adam 117 ! CALL set_grid( "grid_A", zlon, zlat ) 118 WRITE(*,*) 'A0' 119 CALL set_adam_mooring 120 WRITE(*,*) 'A1' 121 #endif 122 CALL set_grid( "grid_T", glamt, gphit ) 123 CALL set_grid( "grid_U", glamu, gphiu ) 124 CALL set_grid( "grid_V", glamv, gphiv ) 125 CALL set_grid( "grid_W", glamt, gphit ) 118 126 119 127 ! vertical grid definition 120 CALL iom_set_axis_attr( "deptht", gdept_0 )121 CALL iom_set_axis_attr( "depthu", gdept_0 )122 CALL iom_set_axis_attr( "depthv", gdept_0 )123 CALL iom_set_axis_attr( "depthw", gdepw_0 )128 CALL event__set_vert_axis( "deptht", gdept_0 ) 129 CALL event__set_vert_axis( "depthu", gdept_0 ) 130 CALL event__set_vert_axis( "depthv", gdept_0 ) 131 CALL event__set_vert_axis( "depthw", gdepw_0 ) 124 132 # if defined key_floats 125 CALL iom_set_axis_attr( "nfloat", (ji, ji=1,nfloat))133 CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp) ) 126 134 # endif 127 135 … … 130 138 131 139 ! end file definition 132 dtime%second=rdt 133 CALL xios_set_timestep(dtime) 134 CALL xios_close_context_definition() 135 136 CALL xios_update_calendar(0) 140 CALL event__close_io_definition 137 141 #endif 138 142 … … 147 151 !!--------------------------------------------------------------------- 148 152 #if defined key_iomput 149 TYPE(xios_context) :: nemo_hdl150 153 151 154 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 152 CALL xios_get_handle("nemo",nemo_hdl)155 CALL event__swap_context("nemo") 153 156 ELSE 154 CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl)157 CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 155 158 ENDIF 156 CALL xios_set_current_context(nemo_hdl)157 159 158 160 #endif … … 360 362 i_s = 1 361 363 i_e = jpmax_files 364 #if defined key_iomput 365 CALL event__stop_ioserver 366 #endif 362 367 ENDIF 363 368 … … 855 860 !! INTERFACE iom_getatt 856 861 !!---------------------------------------------------------------------- 857 SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )862 SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar, cdvar ) 858 863 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 859 864 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 860 INTEGER , INTENT( out) :: pvar ! read field 865 INTEGER , INTENT( out) :: pvar ! written field 866 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 861 867 ! 862 868 IF( kiomid > 0 ) THEN … … 864 870 SELECT CASE (iom_file(kiomid)%iolib) 865 871 CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available') 866 CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pv ar )872 CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pv_i0d=pvar ) 867 873 CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available') 868 874 CASE DEFAULT … … 873 879 END SUBROUTINE iom_g0d_intatt 874 880 881 SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar ) 882 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 883 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 884 REAL(wp) , INTENT( out) :: pvar ! written field 885 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 886 ! 887 IF( kiomid > 0 ) THEN 888 IF( iom_file(kiomid)%nfid > 0 ) THEN 889 SELECT CASE (iom_file(kiomid)%iolib) 890 CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available') 891 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 892 CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar, cdvar=cdvar ) 893 ELSE 894 CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar ) 895 ENDIF 896 CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available') 897 CASE DEFAULT 898 CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 899 END SELECT 900 ENDIF 901 ENDIF 902 END SUBROUTINE iom_g0d_ratt 875 903 876 904 !!---------------------------------------------------------------------- … … 973 1001 REAL(wp) , INTENT(in) :: pfield0d 974 1002 #if defined key_iomput 975 CALL xios_send_field(cdname, (/pfield0d/))1003 CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 976 1004 #else 977 1005 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 982 1010 CHARACTER(LEN=*) , INTENT(in) :: cdname 983 1011 REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d 1012 INTEGER :: jpz 984 1013 #if defined key_iomput 985 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 1014 jpz=SIZE(pfield1d) 1015 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 986 1016 #else 987 1017 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings … … 993 1023 REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d 994 1024 #if defined key_iomput 995 CALL xios_send_field(cdname, pfield2d)1025 CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 996 1026 #else 997 1027 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings … … 1003 1033 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1004 1034 #if defined key_iomput 1005 CALL xios_send_field(cdname, pfield3d)1035 CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 1006 1036 #else 1007 1037 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings … … 1013 1043 #if defined key_iomput 1014 1044 1015 SUBROUTINE iom_set_domain_attr( cdname, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1016 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1017 CHARACTER(LEN=*) , INTENT(in) :: cdname 1018 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1019 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1020 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1021 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1022 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1023 1024 IF ( xios_is_valid_domain (cdname) ) THEN 1025 CALL xios_set_domain_attr ( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1026 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1027 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1028 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1029 ENDIF 1030 1031 IF ( xios_is_valid_domaingroup(cdname) ) THEN 1032 CALL xios_set_domaingroup_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1033 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1034 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1035 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1036 ENDIF 1037 1038 END SUBROUTINE iom_set_domain_attr 1039 1040 1041 SUBROUTINE iom_set_axis_attr( cdname, paxis ) 1042 CHARACTER(LEN=*) , INTENT(in) :: cdname 1043 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1044 IF ( xios_is_valid_axis (cdname) ) CALL xios_set_axis_attr ( cdname, size=size(paxis),value=paxis ) 1045 IF ( xios_is_valid_axisgroup(cdname) ) CALL xios_set_axisgroup_attr( cdname, size=size(paxis),value=paxis ) 1046 END SUBROUTINE iom_set_axis_attr 1047 1048 1049 SUBROUTINE iom_set_field_attr( cdname, freq_op) 1050 CHARACTER(LEN=*) , INTENT(in) :: cdname 1051 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1052 IF ( xios_is_valid_field (cdname) ) CALL xios_set_field_attr ( cdname, freq_op=freq_op ) 1053 IF ( xios_is_valid_fieldgroup(cdname) ) CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 1054 END SUBROUTINE iom_set_field_attr 1055 1056 1057 SUBROUTINE iom_set_file_attr( cdname, name, name_suffix ) 1058 CHARACTER(LEN=*) , INTENT(in) :: cdname 1059 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1060 IF ( xios_is_valid_file (cdname) ) CALL xios_set_file_attr ( cdname, name=name, name_suffix=name_suffix ) 1061 IF ( xios_is_valid_filegroup(cdname) ) CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 1062 END SUBROUTINE iom_set_file_attr 1063 1064 1065 SUBROUTINE iom_set_grid_attr( cdname, mask ) 1066 CHARACTER(LEN=*) , INTENT(in) :: cdname 1067 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1068 IF ( xios_is_valid_grid (cdname) ) CALL xios_set_grid_attr ( cdname, mask=mask ) 1069 IF ( xios_is_valid_gridgroup(cdname) ) CALL xios_set_gridgroup_attr( cdname, mask=mask ) 1070 END SUBROUTINE iom_set_grid_attr 1071 1072 1073 SUBROUTINE set_grid( cdgrd, plon, plat ) 1045 SUBROUTINE set_grid( cdname, plon, plat ) 1074 1046 !!---------------------------------------------------------------------- 1075 1047 !! *** ROUTINE *** … … 1078 1050 !! 1079 1051 !!---------------------------------------------------------------------- 1080 CHARACTER(LEN= 1) , INTENT(in) :: cdgrd1052 CHARACTER(LEN=*) , INTENT(in) :: cdname 1081 1053 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon 1082 1054 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1083 ! 1084 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1085 INTEGER :: ni,nj 1086 1087 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1088 1089 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1090 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1091 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1092 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1093 1094 IF ( ln_mskland ) THEN 1095 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1096 SELECT CASE ( cdgrd ) 1097 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1098 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1099 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpi,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1100 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1101 END SELECT 1102 ! 1103 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = zmask(:,:,1) /= 0. ) 1104 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = zmask(:,:,:) /= 0. ) 1105 ENDIF 1106 1055 1056 CALL event__set_grid_dimension( cdname, jpiglo, jpjglo) 1057 CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, & 1058 & plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) ) 1059 CALL event__set_grid_type_nemo( cdname ) 1060 1107 1061 END SUBROUTINE set_grid 1108 1062 … … 1117 1071 REAL(wp), DIMENSION(1,1) :: zz = 1. 1118 1072 !!---------------------------------------------------------------------- 1119 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)1120 CALL iom_set_domain_attr('scalarpoint', data_dim=1)1121 CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /))1073 CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1) 1074 CALL event__set_grid_domain ( 'scalarpoint', 1, 1, narea, 1, zz, zz ) 1075 CALL event__set_grid_type_nemo( 'scalarpoint' ) 1122 1076 1123 1077 END SUBROUTINE set_scalar 1124 1078 1079 #if defined key_adam 1080 1081 SUBROUTINE set_adam_mooring 1082 !!---------------------------------------------------------------------- 1083 !! *** ROUTINE *** 1084 !! 1085 !! ** Purpose : define fake grids for adam's mooring data 1086 !! 1087 !!---------------------------------------------------------------------- 1088 REAL(wp) ,DIMENSION( 2833,1) :: zlon 1089 REAL(wp) ,DIMENSION( 2833,1) :: zlat 1090 INTEGER ,DIMENSION( 2833,1) :: ix 1091 INTEGER ,DIMENSION( 2833,1) :: iy 1092 INTEGER :: ji 1093 !!---------------------------------------------------------------------- 1094 # include "NA_lons.h90" 1095 # include "NA_lats.h90" 1096 DO ji = 1, 2833 1097 CALL dom_ngb( zlon(ji), zlat(ji), ix(ji), iy(ji), 'T' ) 1098 ENDDO 1099 ! WRITE(*,*) 'CLOSEST', narea, ix(1), iy(1), zlon(1), zlat(1) 1100 WRITE(*,*) 'a0' 1101 ! CALL event__set_grid_dimension( 'grid_A', 1, 1) 1102 CALL event__set_grid_dimension( 'grid_A', 2833, 1) 1103 ! CALL event__set_grid_dimension( 'scalarpointX', jpnij, 1) 1104 WRITE(*,*) 'a1' 1105 ! CALL event__set_grid_domain ( 'grid_A', 1, 1, ix(1), iy(1), zlon(1), zlat(1) ) 1106 CALL event__set_grid_domain ( 'grid_A', 2833, 1, 1, 1, zlon, zlat ) 1107 ! CALL event__set_grid_domain ( 'scalarpointX', 1, 1, narea, 1, 1, 1 ) 1108 WRITE(*,*) 'a2' 1109 CALL event__set_grid_type_nemo( 'grid_A' ) 1110 ! CALL event__set_grid_type_nemo( 'scalarpointX' ) 1111 WRITE(*,*) 'a3' 1112 1113 END SUBROUTINE set_adam_mooring 1114 1115 #endif 1125 1116 1126 1117 SUBROUTINE set_xmlatt … … 1131 1122 !! 1132 1123 !!---------------------------------------------------------------------- 1124 #if defined key_adam 1125 CHARACTER(len=6),DIMENSION( 9) :: clsuff ! suffix name 1126 #else 1133 1127 CHARACTER(len=6),DIMENSION( 8) :: clsuff ! suffix name 1128 #endif 1134 1129 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 1135 1130 CHARACTER(len=50) :: clname ! file name 1136 1131 CHARACTER(len=1) :: cl1 ! 1 character 1137 1132 CHARACTER(len=2) :: cl2 ! 1 character 1138 CHARACTER(len=255) :: tfo1139 1133 INTEGER :: idt ! time-step in seconds 1140 1134 INTEGER :: iddss, ihhss ! number of seconds in 1 day, 1 hour and 1 year … … 1156 1150 1157 1151 ! frequency of the call of iom_put (attribut: freq_op) 1158 tfo = TRIM(i2str(idt))//'s' 1159 CALL iom_set_field_attr('field_definition', freq_op=tfo) 1160 CALL iom_set_field_attr('SBC' , freq_op=TRIM(i2str(idt* nn_fsbc ))//'s') 1161 CALL iom_set_field_attr('ptrc_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1162 CALL iom_set_field_attr('diad_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1163 1152 CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt ) ) ! model time-step 1153 CALL event__set_attribut( 'SBC' , attr( field__freq_op, idt * nn_fsbc ) ) ! SBC time-step 1154 1164 1155 ! output file names (attribut: name) 1156 #if defined key_adam 1157 clsuff(:) = (/ 'grid_A', 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /) 1158 #else 1165 1159 clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /) 1160 #endif 1161 WRITE(*,*) 'set adam2' 1166 1162 DO jg = 1, SIZE(clsuff) ! grid type 1167 DO jh = 1, 24 ! 1-24 hours 1168 WRITE(cl2,'(i2)') jh 1169 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1170 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 1163 DO jh = 1, 12 ! 1, 2, 3, 4, 6, 12 hours 1164 IF( MOD(12,jh) == 0 ) THEN 1165 WRITE(cl2,'(i2)') jh 1166 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1167 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1168 ENDIF 1171 1169 END DO 1172 DO jd = 1, 30 ! 1-30days1170 DO jd = 1, 5, 2 ! 1, 3, 5 days 1173 1171 WRITE(cl1,'(i1)') jd 1174 1172 CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 1175 CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname))1173 CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1176 1174 END DO 1177 DO jm = 1, 11 ! 1-11 months 1178 WRITE(cl1,'(i1)') jm 1179 CALL dia_nam( clname, -jm, clsuff(jg) ) 1180 CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 1175 DO jm = 1, 6 ! 1, 2, 3, 4, 6 months 1176 IF( MOD(6,jm) == 0 ) THEN 1177 WRITE(cl1,'(i1)') jm 1178 CALL dia_nam( clname, -jm, clsuff(jg) ) 1179 CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1180 ENDIF 1181 1181 END DO 1182 DO jy = 1, 50 ! 1-50 years 1183 WRITE(cl2,'(i2)') jy 1184 CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 1185 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 1182 DO jy = 1, 10 ! 1, 2, 5, 10 years 1183 IF( MOD(10,jy) == 0 ) THEN 1184 WRITE(cl2,'(i2)') jy 1185 CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 1186 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1187 ENDIF 1186 1188 END DO 1187 1189 END DO … … 1193 1195 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1194 1196 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1195 CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1196 CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 1197 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin , iy ) ) 1198 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni , jpiglo ) ) 1199 CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq' ) ) 1197 1200 END DO 1198 1201 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) … … 1209 1212 CALL set_mooring( zlonpira, zlatpira ) 1210 1213 1214 WRITE(*,*) 'set adam3' 1211 1215 END SUBROUTINE set_xmlatt 1212 1216 … … 1269 1273 ENDIF 1270 1274 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1271 CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1272 CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 1275 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin , ix ) ) 1276 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin , iy ) ) 1277 CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) ) 1273 1278 END DO 1274 1279 END DO … … 1286 1291 #endif 1287 1292 1288 FUNCTION i2str(int) 1289 IMPLICIT NONE 1290 INTEGER, INTENT(IN) :: int 1291 CHARACTER(LEN=255) :: i2str 1292 1293 WRITE(i2str,*) int 1294 1295 END FUNCTION i2str 1296 1293 1297 1294 !!====================================================================== 1298 1295 END MODULE iom -
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r3680 r6736 43 43 INTEGER, PARAMETER, PUBLIC :: jp_i1 = 204 !: write INTEGER(1) 44 44 45 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 100 !: maximum number of simultaneously opened file45 INTEGER, PARAMETER, PUBLIC :: jpmax_files = 50 !: maximum number of simultaneously opened file 46 46 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 360 !: maximum number of variables in one file 47 47 INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable -
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r2715 r6736 7 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 8 !! " ! 07 07 (D. Storkey) Changes to iom_nf90_gettime 9 !! ! 13 04 (J. Harle) Additions to iom_nf90_getatt 9 10 !!-------------------------------------------------------------------- 10 11 !!gm caution add !DIR nec: improved performance to be checked as well as no result changes … … 35 36 END INTERFACE 36 37 INTERFACE iom_nf90_getatt 37 MODULE PROCEDURE iom_nf90_ intatt38 MODULE PROCEDURE iom_nf90_att 38 39 END INTERFACE 39 40 INTERFACE iom_nf90_rstput … … 308 309 309 310 310 SUBROUTINE iom_nf90_ intatt( kiomid, cdatt, pvar)311 !!----------------------------------------------------------------------- 312 !! *** ROUTINE iom_nf90_ intatt ***311 SUBROUTINE iom_nf90_att( kiomid, cdatt, pv_i0d, pv_r0d, cdvar) 312 !!----------------------------------------------------------------------- 313 !! *** ROUTINE iom_nf90_att *** 313 314 !! 314 315 !! ** Purpose : read an integer attribute with NF90 … … 316 317 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 317 318 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 318 INTEGER , INTENT( out) :: pvar ! read field 319 INTEGER , INTENT( out), OPTIONAL :: pv_i0d ! read field 320 REAL(wp), INTENT( out), OPTIONAL :: pv_r0d ! read field 321 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! name of the variable 319 322 ! 320 323 INTEGER :: if90id ! temporary integer 324 INTEGER :: ivarid ! NetCDF variable Id 321 325 LOGICAL :: llok ! temporary logical 322 326 CHARACTER(LEN=100) :: clinfo ! info character … … 324 328 ! 325 329 if90id = iom_file(kiomid)%nfid 326 llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 330 IF( PRESENT(cdvar) ) THEN 331 llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr ! does the variable exist in the file 332 IF( llok ) THEN 333 llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr 334 ELSE 335 CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found') 336 ENDIF 337 ELSE 338 llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 339 ENDIF 340 ! 327 341 IF( llok) THEN 328 342 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 329 CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo) 343 IF( PRESENT(pv_r0d) ) THEN 344 IF( PRESENT(cdvar) ) THEN 345 CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 346 ELSE 347 CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_r0d), clinfo) 348 ENDIF 349 ELSE 350 IF( PRESENT(cdvar) ) THEN 351 CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 352 ELSE 353 CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_i0d), clinfo) 354 ENDIF 355 ENDIF 330 356 ELSE 331 357 CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 332 pvar = -999 358 IF( PRESENT(pv_r0d) ) THEN 359 pv_r0d = -999._wp 360 ELSE 361 pv_i0d = -999 362 ENDIF 333 363 ENDIF 334 364 ! 335 END SUBROUTINE iom_nf90_ intatt365 END SUBROUTINE iom_nf90_att 336 366 337 367 -
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r3680 r6736 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 #if defined key_nemocice_decomp11 USE ice_domain_size, only: nx_global, ny_global12 #endif13 10 USE in_out_manager ! I/O manager 14 11 USE lib_mpp ! distributed memory computing … … 33 30 PUBLIC prt_ctl_info ! called by all subroutines 34 31 PUBLIC prt_ctl_init ! called by opa.F90 35 PUBLIC sub_dom ! called by opa.F9036 32 37 33 !!---------------------------------------------------------------------- … … 423 419 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 424 420 425 INTEGER, POINTER, DIMENSION(:,:):: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace421 INTEGER, DIMENSION(:,:), ALLOCATABLE :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 426 422 REAL(wp) :: zidom, zjdom ! temporary scalars 427 423 !!---------------------------------------------------------------------- 428 424 429 !430 CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )431 !432 425 ! 1. Dimension arrays for subdomains 433 426 ! ----------------------------------- … … 438 431 ! array (cf. par_oce.F90). 439 432 433 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 440 434 #if defined key_nemocice_decomp 441 ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 442 ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 435 ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 443 436 #else 444 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci445 437 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 446 438 #endif 447 439 440 ALLOCATE(ilcitl (isplt,jsplt)) 441 ALLOCATE(ilcjtl (isplt,jsplt)) 448 442 449 443 nrecil = 2 * jpreci … … 518 512 ! ------------------------------- 519 513 514 ALLOCATE(iimpptl(isplt,jsplt)) 515 ALLOCATE(ijmpptl(isplt,jsplt)) 516 520 517 iimpptl(:,:) = 1 521 518 ijmpptl(:,:) = 1 … … 575 572 END DO 576 573 ! 577 ! 578 CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 579 ! 574 DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 580 575 ! 581 576 END SUBROUTINE sub_dom -
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r3680 r6736 24 24 USE trdmld_oce ! ocean active mixed layer tracers trends variables 25 25 USE domvvl ! variable volume 26 USE divcur ! hor. divergence and curl (div & cur routines)27 26 28 27 IMPLICIT NONE … … 32 31 PUBLIC rst_write ! routine called by step module 33 32 PUBLIC rst_read ! routine called by opa module 33 34 LOGICAL, PUBLIC :: lrst_oce = .FALSE. !: logical to control the oce restart write 35 INTEGER, PUBLIC :: numror, numrow !: logical unit for cean restart (read and write) 34 36 35 37 !! * Substitutions … … 119 121 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 120 122 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 121 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 123 #if ! defined key_jth_fix 124 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 125 #endif 122 126 ! 123 127 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 181 185 ENDIF 182 186 ! 183 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 184 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 185 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb ) 186 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 187 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 188 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb ) 189 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 190 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 191 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 192 ELSE 193 neuler = 0 194 ENDIF 195 ! 196 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 197 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn ) 198 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem) ) 199 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 200 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 201 IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN 202 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn ) 203 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn ) 204 ELSE 205 CALL div_cur( 0 ) ! Horizontal divergence & Relative vorticity 206 ENDIF 207 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 208 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 209 ELSE 210 CALL eos ( tsn, rhd, rhop ) 211 ENDIF 187 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 188 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb ) 189 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 190 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 191 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb ) 192 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 193 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 194 #if ! defined key_jth_fix 195 IF( lk_vvl ) THEN 196 DO jk = 1, jpk 197 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 198 END DO 199 ENDIF 200 IF( lk_vvl .AND. ln_fse3t_b ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 201 #endif 202 ! 203 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 204 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn ) 205 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem) ) 206 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 207 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn ) 208 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn ) 209 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 210 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 212 211 #if defined key_zdfkpp 213 212 IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN 214 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly213 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly 215 214 ELSE 216 CALL eos( tsn, rhd ) ! compute rhd215 CALL eos( tsn, rhd ) ! compute rhd 217 216 ENDIF 218 217 #endif … … 225 224 hdivb(:,:,:) = hdivn(:,:,:) 226 225 sshb (:,:) = sshn (:,:) 226 #if ! defined key_jth_fix 227 227 IF( lk_vvl ) THEN 228 228 DO jk = 1, jpk … … 230 230 END DO 231 231 ENDIF 232 #endif 232 233 ENDIF 233 234 !
Note: See TracChangeset
for help on using the changeset viewer.