- Timestamp:
- 2020-07-03T19:15:31+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r13229 r13247 59 59 PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 60 60 61 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 62 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 63 PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d 61 PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 62 PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 63 PRIVATE iom_get_123d 64 PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 65 PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 66 PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 67 PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 64 68 #if defined key_iomput 65 69 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr … … 70 74 71 75 INTERFACE iom_get 72 MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d 76 MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 77 MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 73 78 END INTERFACE 74 79 INTERFACE iom_getatt … … 79 84 END INTERFACE 80 85 INTERFACE iom_rstput 81 MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 86 MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 87 MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 82 88 END INTERFACE 83 89 INTERFACE iom_put 84 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d 90 MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 91 MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 85 92 END INTERFACE iom_put 86 93 … … 153 160 ! 154 161 IF( ln_cfmeta ) THEN ! Add additional grid metadata 155 CALL iom_set_domain_attr("grid_T", area = e1e2t(Nis0:Nie0, Njs0:Nje0))156 CALL iom_set_domain_attr("grid_U", area = e1e2u(Nis0:Nie0, Njs0:Nje0))157 CALL iom_set_domain_attr("grid_V", area = e1e2v(Nis0:Nie0, Njs0:Nje0))158 CALL iom_set_domain_attr("grid_W", area = e1e2t(Nis0:Nie0, Njs0:Nje0))162 CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 163 CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 164 CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 165 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 159 166 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 160 167 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 176 183 ! 177 184 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 178 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0))179 CALL iom_set_domain_attr("grid_U", area = e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0))180 CALL iom_set_domain_attr("grid_V", area = e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0))181 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0))185 CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 186 CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 187 CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 188 CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 182 189 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 183 190 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 881 888 !! INTERFACE iom_get 882 889 !!---------------------------------------------------------------------- 883 SUBROUTINE iom_g0d ( kiomid, cdvar, pvar, ktime, ldxios )890 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 884 891 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 885 892 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 886 REAL(wp) , INTENT( out) :: pvar ! read field 893 REAL(sp) , INTENT( out) :: pvar ! read field 894 REAL(dp) :: ztmp_pvar ! tmp var to read field 895 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 896 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 897 ! 898 INTEGER :: idvar ! variable id 899 INTEGER :: idmspc ! number of spatial dimensions 900 INTEGER , DIMENSION(1) :: itime ! record number 901 CHARACTER(LEN=100) :: clinfo ! info character 902 CHARACTER(LEN=100) :: clname ! file name 903 CHARACTER(LEN=1) :: cldmspc ! 904 LOGICAL :: llxios 905 ! 906 llxios = .FALSE. 907 IF( PRESENT(ldxios) ) llxios = ldxios 908 909 IF(.NOT.llxios) THEN ! read data using default library 910 itime = 1 911 IF( PRESENT(ktime) ) itime = ktime 912 ! 913 clname = iom_file(kiomid)%name 914 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 915 ! 916 IF( kiomid > 0 ) THEN 917 idvar = iom_varid( kiomid, cdvar ) 918 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 919 idmspc = iom_file ( kiomid )%ndims( idvar ) 920 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 921 WRITE(cldmspc , fmt='(i1)') idmspc 922 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 923 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 924 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 925 CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 926 pvar = ztmp_pvar 927 ENDIF 928 ENDIF 929 ELSE 930 #if defined key_iomput 931 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 932 CALL iom_swap( TRIM(crxios_context) ) 933 CALL xios_recv_field( trim(cdvar), pvar) 934 CALL iom_swap( TRIM(cxios_context) ) 935 #else 936 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 937 CALL ctl_stop( 'iom_g0d', ctmp1 ) 938 #endif 939 ENDIF 940 END SUBROUTINE iom_g0d_sp 941 942 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 943 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 944 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 945 REAL(dp) , INTENT( out) :: pvar ! read field 887 946 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 888 947 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart … … 929 988 #endif 930 989 ENDIF 931 END SUBROUTINE iom_g0d 932 933 SUBROUTINE iom_g1d ( kiomid, kdom, cdvar, pvar, ktime,kstart, kcount, ldxios )990 END SUBROUTINE iom_g0d_dp 991 992 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 934 993 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 935 994 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 936 995 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 937 REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field 996 REAL(sp) , INTENT( out), DIMENSION(:) :: pvar ! read field 997 REAL(dp) , ALLOCATABLE , DIMENSION(:) :: ztmp_pvar ! tmp var to read field 938 998 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 939 999 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading … … 942 1002 ! 943 1003 IF( kiomid > 0 ) THEN 944 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 945 & ktime=ktime , & 946 & kstart=kstart, kcount=kcount , ldxios=ldxios ) 947 ENDIF 948 END SUBROUTINE iom_g1d 949 950 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1004 IF( iom_file(kiomid)%nfid > 0 ) THEN 1005 ALLOCATE(ztmp_pvar(size(pvar,1))) 1006 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1007 & ktime=ktime, kstart=kstart, kcount=kcount, & 1008 & ldxios=ldxios ) 1009 pvar = ztmp_pvar 1010 DEALLOCATE(ztmp_pvar) 1011 END IF 1012 ENDIF 1013 END SUBROUTINE iom_g1d_sp 1014 1015 1016 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 951 1017 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 952 1018 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 953 1019 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 954 REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1020 REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1021 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1022 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1023 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1024 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1025 ! 1026 IF( kiomid > 0 ) THEN 1027 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 1028 & ktime=ktime, kstart=kstart, kcount=kcount, & 1029 & ldxios=ldxios ) 1030 ENDIF 1031 END SUBROUTINE iom_g1d_dp 1032 1033 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1034 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1035 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1036 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1037 REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1038 REAL(dp) , ALLOCATABLE , DIMENSION(:,:) :: ztmp_pvar ! tmp var to read field 955 1039 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 956 1040 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 957 REAL( wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold1041 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 958 1042 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 959 1043 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading … … 962 1046 ! 963 1047 IF( kiomid > 0 ) THEN 1048 IF( iom_file(kiomid)%nfid > 0 ) THEN 1049 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 1050 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1051 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1052 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1053 pvar = ztmp_pvar 1054 DEALLOCATE(ztmp_pvar) 1055 ENDIF 1056 ENDIF 1057 END SUBROUTINE iom_g2d_sp 1058 1059 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1060 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1061 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1062 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1063 REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1064 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1065 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1066 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1067 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1068 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1069 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1070 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1071 ! 1072 IF( kiomid > 0 ) THEN 964 1073 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 965 1074 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 966 1075 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 967 1076 ENDIF 968 END SUBROUTINE iom_g2d 969 970 SUBROUTINE iom_g3d ( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios )1077 END SUBROUTINE iom_g2d_dp 1078 1079 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 971 1080 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 972 1081 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 973 1082 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 974 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1083 REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1084 REAL(dp) , ALLOCATABLE , DIMENSION(:,:,:) :: ztmp_pvar ! tmp var to read field 975 1085 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 976 1086 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 977 REAL( wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold1087 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 978 1088 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 979 1089 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading … … 982 1092 ! 983 1093 IF( kiomid > 0 ) THEN 984 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1094 IF( iom_file(kiomid)%nfid > 0 ) THEN 1095 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 1096 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 985 1097 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 986 1098 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 987 ENDIF 988 END SUBROUTINE iom_g3d 1099 pvar = ztmp_pvar 1100 DEALLOCATE(ztmp_pvar) 1101 END IF 1102 ENDIF 1103 END SUBROUTINE iom_g3d_sp 1104 1105 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 1106 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1107 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1108 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1109 REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1110 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1111 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1112 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1113 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1114 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1115 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1116 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1117 ! 1118 IF( kiomid > 0 ) THEN 1119 IF( iom_file(kiomid)%nfid > 0 ) THEN 1120 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1121 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1122 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1123 END IF 1124 ENDIF 1125 END SUBROUTINE iom_g3d_dp 1126 989 1127 !!---------------------------------------------------------------------- 990 1128 … … 1001 1139 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1002 1140 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1003 REAL( wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)1004 REAL( wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)1005 REAL( wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)1141 REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1142 REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1143 REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1006 1144 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1007 1145 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1008 REAL( wp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold1146 REAL(dp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1009 1147 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1010 1148 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis … … 1029 1167 INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable 1030 1168 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1031 REAL( wp) :: zscf, zofs ! sacle_factor and add_offset1169 REAL(dp) :: zscf, zofs ! sacle_factor and add_offset 1032 1170 REAL(wp) :: zsgn ! local value of psgn 1033 1171 INTEGER :: itmp ! temporary integer … … 1038 1176 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1039 1177 INTEGER :: inlev ! number of levels for 3D data 1040 REAL( wp) :: gma, gmi1178 REAL(dp) :: gma, gmi 1041 1179 !--------------------------------------------------------------------- 1042 1180 ! … … 1238 1376 !some final adjustments 1239 1377 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1240 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1. )1241 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1. )1378 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 1379 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 1242 1380 1243 1381 !--- Apply scale_factor and offset … … 1426 1564 !! INTERFACE iom_rstput 1427 1565 !!---------------------------------------------------------------------- 1428 SUBROUTINE iom_rp0d ( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1566 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1429 1567 INTEGER , INTENT(in) :: kt ! ocean time-step 1430 1568 INTEGER , INTENT(in) :: kwrite ! writing time-step 1431 1569 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1432 1570 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1433 REAL( wp) , INTENT(in) :: pvar ! written field1571 REAL(sp) , INTENT(in) :: pvar ! written field 1434 1572 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1435 1573 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1450 1588 IF( iom_file(kiomid)%nfid > 0 ) THEN 1451 1589 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1452 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar)1590 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 1453 1591 ENDIF 1454 1592 ENDIF 1455 1593 ENDIF 1456 END SUBROUTINE iom_rp0d 1457 1458 SUBROUTINE iom_rp 1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1594 END SUBROUTINE iom_rp0d_sp 1595 1596 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1459 1597 INTEGER , INTENT(in) :: kt ! ocean time-step 1460 1598 INTEGER , INTENT(in) :: kwrite ! writing time-step 1461 1599 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1462 1600 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1463 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1601 REAL(dp) , INTENT(in) :: pvar ! written field 1602 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1603 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1604 LOGICAL :: llx ! local xios write flag 1605 INTEGER :: ivid ! variable id 1606 1607 llx = .FALSE. 1608 IF(PRESENT(ldxios)) llx = ldxios 1609 IF( llx ) THEN 1610 #ifdef key_iomput 1611 IF( kt == kwrite ) THEN 1612 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1613 CALL xios_send_field(trim(cdvar), pvar) 1614 ENDIF 1615 #endif 1616 ELSE 1617 IF( kiomid > 0 ) THEN 1618 IF( iom_file(kiomid)%nfid > 0 ) THEN 1619 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1620 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1621 ENDIF 1622 ENDIF 1623 ENDIF 1624 END SUBROUTINE iom_rp0d_dp 1625 1626 1627 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1628 INTEGER , INTENT(in) :: kt ! ocean time-step 1629 INTEGER , INTENT(in) :: kwrite ! writing time-step 1630 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1631 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1632 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1464 1633 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1465 1634 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1480 1649 IF( iom_file(kiomid)%nfid > 0 ) THEN 1481 1650 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1482 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar)1651 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 1483 1652 ENDIF 1484 1653 ENDIF 1485 1654 ENDIF 1486 END SUBROUTINE iom_rp1d 1487 1488 SUBROUTINE iom_rp 2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1655 END SUBROUTINE iom_rp1d_sp 1656 1657 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1489 1658 INTEGER , INTENT(in) :: kt ! ocean time-step 1490 1659 INTEGER , INTENT(in) :: kwrite ! writing time-step 1491 1660 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1492 1661 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1493 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1662 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1663 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1664 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1665 LOGICAL :: llx ! local xios write flag 1666 INTEGER :: ivid ! variable id 1667 1668 llx = .FALSE. 1669 IF(PRESENT(ldxios)) llx = ldxios 1670 IF( llx ) THEN 1671 #ifdef key_iomput 1672 IF( kt == kwrite ) THEN 1673 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1674 CALL xios_send_field(trim(cdvar), pvar) 1675 ENDIF 1676 #endif 1677 ELSE 1678 IF( kiomid > 0 ) THEN 1679 IF( iom_file(kiomid)%nfid > 0 ) THEN 1680 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1681 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1682 ENDIF 1683 ENDIF 1684 ENDIF 1685 END SUBROUTINE iom_rp1d_dp 1686 1687 1688 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1689 INTEGER , INTENT(in) :: kt ! ocean time-step 1690 INTEGER , INTENT(in) :: kwrite ! writing time-step 1691 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1692 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1693 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1494 1694 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1495 1695 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1510 1710 IF( iom_file(kiomid)%nfid > 0 ) THEN 1511 1711 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1512 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar)1712 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 1513 1713 ENDIF 1514 1714 ENDIF 1515 1715 ENDIF 1516 END SUBROUTINE iom_rp2d 1517 1518 SUBROUTINE iom_rp 3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1716 END SUBROUTINE iom_rp2d_sp 1717 1718 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1519 1719 INTEGER , INTENT(in) :: kt ! ocean time-step 1520 1720 INTEGER , INTENT(in) :: kwrite ! writing time-step 1521 1721 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1522 1722 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1523 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1723 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1724 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1725 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1726 LOGICAL :: llx 1727 INTEGER :: ivid ! variable id 1728 1729 llx = .FALSE. 1730 IF(PRESENT(ldxios)) llx = ldxios 1731 IF( llx ) THEN 1732 #ifdef key_iomput 1733 IF( kt == kwrite ) THEN 1734 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1735 CALL xios_send_field(trim(cdvar), pvar) 1736 ENDIF 1737 #endif 1738 ELSE 1739 IF( kiomid > 0 ) THEN 1740 IF( iom_file(kiomid)%nfid > 0 ) THEN 1741 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1742 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1743 ENDIF 1744 ENDIF 1745 ENDIF 1746 END SUBROUTINE iom_rp2d_dp 1747 1748 1749 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1750 INTEGER , INTENT(in) :: kt ! ocean time-step 1751 INTEGER , INTENT(in) :: kwrite ! writing time-step 1752 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1753 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1754 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1524 1755 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1525 1756 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1540 1771 IF( iom_file(kiomid)%nfid > 0 ) THEN 1541 1772 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1773 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 1774 ENDIF 1775 ENDIF 1776 ENDIF 1777 END SUBROUTINE iom_rp3d_sp 1778 1779 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1780 INTEGER , INTENT(in) :: kt ! ocean time-step 1781 INTEGER , INTENT(in) :: kwrite ! writing time-step 1782 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1783 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1784 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1785 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1786 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1787 LOGICAL :: llx ! local xios write flag 1788 INTEGER :: ivid ! variable id 1789 1790 llx = .FALSE. 1791 IF(PRESENT(ldxios)) llx = ldxios 1792 IF( llx ) THEN 1793 #ifdef key_iomput 1794 IF( kt == kwrite ) THEN 1795 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1796 CALL xios_send_field(trim(cdvar), pvar) 1797 ENDIF 1798 #endif 1799 ELSE 1800 IF( kiomid > 0 ) THEN 1801 IF( iom_file(kiomid)%nfid > 0 ) THEN 1802 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1542 1803 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1543 1804 ENDIF 1544 1805 ENDIF 1545 1806 ENDIF 1546 END SUBROUTINE iom_rp3d 1807 END SUBROUTINE iom_rp3d_dp 1808 1547 1809 1548 1810 … … 1596 1858 !! INTERFACE iom_put 1597 1859 !!---------------------------------------------------------------------- 1598 SUBROUTINE iom_p0d ( cdname, pfield0d )1860 SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 1599 1861 CHARACTER(LEN=*), INTENT(in) :: cdname 1600 REAL( wp) , INTENT(in) :: pfield0d1862 REAL(sp) , INTENT(in) :: pfield0d 1601 1863 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1602 1864 #if defined key_iomput … … 1607 1869 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 1608 1870 #endif 1609 END SUBROUTINE iom_p0d 1610 1611 SUBROUTINE iom_p1d( cdname, pfield1d ) 1871 END SUBROUTINE iom_p0d_sp 1872 1873 SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 1874 CHARACTER(LEN=*), INTENT(in) :: cdname 1875 REAL(dp) , INTENT(in) :: pfield0d 1876 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1877 #if defined key_iomput 1878 !!clem zz(:,:)=pfield0d 1879 !!clem CALL xios_send_field(cdname, zz) 1880 CALL xios_send_field(cdname, (/pfield0d/)) 1881 #else 1882 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 1883 #endif 1884 END SUBROUTINE iom_p0d_dp 1885 1886 1887 SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 1612 1888 CHARACTER(LEN=*) , INTENT(in) :: cdname 1613 REAL( wp), DIMENSION(:), INTENT(in) :: pfield1d1889 REAL(sp), DIMENSION(:), INTENT(in) :: pfield1d 1614 1890 #if defined key_iomput 1615 1891 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) … … 1617 1893 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 1618 1894 #endif 1619 END SUBROUTINE iom_p1d 1620 1621 SUBROUTINE iom_p2d( cdname, pfield2d ) 1895 END SUBROUTINE iom_p1d_sp 1896 1897 SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 1898 CHARACTER(LEN=*) , INTENT(in) :: cdname 1899 REAL(dp), DIMENSION(:), INTENT(in) :: pfield1d 1900 #if defined key_iomput 1901 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 1902 #else 1903 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 1904 #endif 1905 END SUBROUTINE iom_p1d_dp 1906 1907 SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 1622 1908 CHARACTER(LEN=*) , INTENT(in) :: cdname 1623 REAL( wp), DIMENSION(:,:), INTENT(in) :: pfield2d1909 REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d 1624 1910 IF( iom_use(cdname) ) THEN 1625 1911 #if defined key_iomput … … 1633 1919 #endif 1634 1920 ENDIF 1635 END SUBROUTINE iom_p2d 1636 1637 SUBROUTINE iom_p3d( cdname, pfield3d ) 1921 END SUBROUTINE iom_p2d_sp 1922 1923 SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 1924 CHARACTER(LEN=*) , INTENT(in) :: cdname 1925 REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d 1926 IF( iom_use(cdname) ) THEN 1927 #if defined key_iomput 1928 IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 1929 CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) ) ! this extraction will create a copy of pfield2d 1930 ELSE 1931 CALL xios_send_field( cdname, pfield2d ) 1932 ENDIF 1933 #else 1934 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1935 #endif 1936 ENDIF 1937 END SUBROUTINE iom_p2d_dp 1938 1939 SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 1638 1940 CHARACTER(LEN=*) , INTENT(in) :: cdname 1639 REAL( wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d1941 REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1640 1942 IF( iom_use(cdname) ) THEN 1641 1943 #if defined key_iomput … … 1649 1951 #endif 1650 1952 ENDIF 1651 END SUBROUTINE iom_p3d 1652 1653 SUBROUTINE iom_p 4d( cdname, pfield4d )1953 END SUBROUTINE iom_p3d_sp 1954 1955 SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 1654 1956 CHARACTER(LEN=*) , INTENT(in) :: cdname 1655 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1957 REAL(dp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1958 IF( iom_use(cdname) ) THEN 1959 #if defined key_iomput 1960 IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 1961 CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) ) ! this extraction will create a copy of pfield3d 1962 ELSE 1963 CALL xios_send_field( cdname, pfield3d ) 1964 ENDIF 1965 #else 1966 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1967 #endif 1968 ENDIF 1969 END SUBROUTINE iom_p3d_dp 1970 1971 SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 1972 CHARACTER(LEN=*) , INTENT(in) :: cdname 1973 REAL(sp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1656 1974 IF( iom_use(cdname) ) THEN 1657 1975 #if defined key_iomput … … 1665 1983 #endif 1666 1984 ENDIF 1667 END SUBROUTINE iom_p4d 1668 1985 END SUBROUTINE iom_p4d_sp 1986 1987 SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 1988 CHARACTER(LEN=*) , INTENT(in) :: cdname 1989 REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1990 IF( iom_use(cdname) ) THEN 1991 #if defined key_iomput 1992 IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 1993 CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) ) ! this extraction will create a copy of pfield4d 1994 ELSE 1995 CALL xios_send_field (cdname, pfield4d ) 1996 ENDIF 1997 #else 1998 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1999 #endif 2000 ENDIF 2001 END SUBROUTINE iom_p4d_dp 1669 2002 1670 2003 #if defined key_iomput … … 1682 2015 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1683 2016 INTEGER , OPTIONAL, INTENT(in) :: nvertex 1684 REAL( wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue1685 REAL( wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area2017 REAL(dp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 2018 REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1686 2019 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1687 2020 !!---------------------------------------------------------------------- … … 1746 2079 !!---------------------------------------------------------------------- 1747 2080 IF( PRESENT(paxis) ) THEN 1748 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1749 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1750 ENDIF 1751 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1752 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 2081 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2082 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2083 ENDIF 2084 IF( PRESENT(bounds) ) THEN 2085 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=real(bounds, dp) ) 2086 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 2087 ELSE 2088 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid) 2089 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid) 2090 END IF 1753 2091 CALL xios_solve_inheritance() 1754 2092 END SUBROUTINE iom_set_axis_attr … … 1865 2203 !don't define lon and lat for restart reading context. 1866 2204 IF ( .NOT.ldrxios ) & 1867 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)), &1868 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))2205 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp), & 2206 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 1869 2207 ! 1870 2208 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 1883 2221 END SUBROUTINE set_grid 1884 2222 1885 1886 2223 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 1887 2224 !!---------------------------------------------------------------------- … … 1897 2234 INTEGER :: ji, jj, jn 1898 2235 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1899 ! ! represents the bottom-left corner of cell (i,j) 2236 ! ! represents the 2237 ! bottom-left corner of 2238 ! cell (i,j) 1900 2239 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1901 2240 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells … … 1913 2252 ! 1914 2253 z_fld(:,:) = 1._wp 1915 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. ) ! Working array for location of northfold2254 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp ) ! Working array for location of northfold 1916 2255 ! 1917 2256 ! Cell vertices that can be defined … … 1935 2274 END_2D 1936 2275 ! 1937 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), &1938 & bounds_lon = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), nvertex=4 )1939 ! 1940 DEALLOCATE( z_bnds, z_fld, z_rot ) 2276 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp), & 2277 & bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 2278 ! 2279 DEALLOCATE( z_bnds, z_fld, z_rot ) 1941 2280 ! 1942 2281 END SUBROUTINE set_grid_bounds 1943 1944 2282 1945 2283 SUBROUTINE set_grid_znl( plat ) … … 1958 2296 ALLOCATE( zlon(Ni_0*Nj_0) ) ; zlon(:) = 0._wp 1959 2297 ! 1960 ! CALL dom_ngb( -168.53 , 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)1961 CALL dom_ngb( 180. , 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)2298 ! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2299 CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1962 2300 CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 1963 2301 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 1964 CALL iom_set_domain_attr("gznl", lonvalue = zlon, &1965 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))2302 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2303 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 1966 2304 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 1967 2305 ! … … 1978 2316 !! 1979 2317 !!---------------------------------------------------------------------- 1980 REAL( wp), DIMENSION(1) :: zz = 1.2318 REAL(dp), DIMENSION(1) :: zz = 1. 1981 2319 !!---------------------------------------------------------------------- 1982 2320 ! … … 2040 2378 cl1 = clgrd(jg) 2041 2379 ! Equatorial section (attributs: jbegin, ni, name_suffix) 2042 CALL dom_ngb( 0. , 0., ix, iy, cl1 )2380 CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 2043 2381 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 2044 2382 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) … … 2266 2604 ! 2267 2605 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 2268 CALL ju2ymds( pjday - 1. , iyear, imonth, iday, zsec )2606 CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 2269 2607 isec = 86400 2270 2608 ENDIF … … 2324 2662 CHARACTER(LEN=*), INTENT(in ) :: cdname 2325 2663 REAL(wp) , INTENT(out) :: pmiss_val 2664 REAL(dp) :: ztmp_pmiss_val 2326 2665 #if defined key_iomput 2327 2666 ! get missing value 2328 CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 2667 CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 2668 pmiss_val = ztmp_pmiss_val 2329 2669 #else 2330 2670 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings
Note: See TracChangeset
for help on using the changeset viewer.