- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/iom.F90 (modified) (53 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/IOM/iom.F90
r12521 r13540 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE domutl ! 23 24 USE c1d ! 1D vertical configuration 24 25 USE flo_oce ! floats module declarations … … 34 35 USE ice , ONLY : jpl 35 36 #endif 36 USE domngb ! ocean space and time domain37 37 USE phycst ! physical constants 38 38 USE dianam ! build name of file … … 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 … … 94 101 CONTAINS 95 102 96 SUBROUTINE iom_init( cdname, fname, ld_ tmppatch, ld_closedef )103 SUBROUTINE iom_init( cdname, fname, ld_closedef ) 97 104 !!---------------------------------------------------------------------- 98 105 !! *** ROUTINE *** … … 103 110 CHARACTER(len=*), INTENT(in) :: cdname 104 111 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 105 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch106 112 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 107 113 #if defined key_iomput … … 111 117 CHARACTER(len=lc) :: clname 112 118 INTEGER :: irefyear, irefmonth, irefday 113 INTEGER :: ji , jkmin119 INTEGER :: ji 114 120 LOGICAL :: llrst_context ! is context related to restart 115 121 ! 116 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 117 123 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 118 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity119 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files120 INTEGER :: nldj_save, nlej_save !:121 124 LOGICAL :: ll_closedef 122 125 !!---------------------------------------------------------------------- 123 126 ! 124 ! seb: patch before we remove periodicity and close boundaries in output files125 IF( PRESENT(ld_tmppatch) ) THEN ; ll_tmppatch = ld_tmppatch126 ELSE ; ll_tmppatch = .TRUE.127 ENDIF128 IF ( ll_tmppatch ) THEN129 nldi_save = nldi ; nlei_save = nlei130 nldj_save = nldj ; nlej_save = nlej131 IF( nimpp == 1 ) nldi = 1132 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi133 IF( njmpp == 1 ) nldj = 1134 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj135 ENDIF136 127 ! 137 128 ll_closedef = .TRUE. … … 152 143 153 144 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 154 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&155 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )156 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&157 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )158 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&159 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )145 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 146 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 147 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 148 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 149 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 150 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 160 151 END SELECT 161 152 … … 171 162 ! 172 163 IF( ln_cfmeta ) THEN ! Add additional grid metadata 173 CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))174 CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))175 CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))176 CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))164 CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 165 CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 166 CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 167 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 177 168 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 178 169 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 194 185 ! 195 186 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 196 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))197 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))198 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))199 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))187 CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 188 CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 189 CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 190 CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 200 191 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 201 192 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 222 213 223 214 ! Add vertical grid bounds 224 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 225 zt_bnds(2,: ) = gdept_1d(:) 226 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 227 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 228 zw_bnds(1,: ) = gdepw_1d(:) 229 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 230 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 215 zt_bnds(2,: ) = gdept_1d(:) 216 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 217 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 218 zw_bnds(1,: ) = gdepw_1d(:) 219 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 220 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 231 221 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 232 222 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) … … 284 274 DEALLOCATE( zt_bnds, zw_bnds ) 285 275 ! 286 IF ( ll_tmppatch ) THEN287 nldi = nldi_save ; nlei = nlei_save288 nldj = nldj_save ; nlej = nlej_save289 ENDIF290 276 #endif 291 277 ! … … 658 644 659 645 660 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev)646 SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp ) 661 647 !!--------------------------------------------------------------------- 662 648 !! *** SUBROUTINE iom_open *** … … 667 653 INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file 668 654 LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.) 669 INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)670 655 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 671 656 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 672 657 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 658 CHARACTER(len=3), INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open 673 659 ! 674 660 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 679 665 LOGICAL :: llok ! check the existence 680 666 LOGICAL :: llwrt ! local definition of ldwrt 681 LOGICAL :: llnoov ! local definition to read overlap682 667 LOGICAL :: llstop ! local definition of ldstop 683 668 LOGICAL :: lliof ! local definition of ldiof 684 669 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 685 670 INTEGER :: iln, ils ! lengths of character 686 INTEGER :: idom ! type of domain687 671 INTEGER :: istop ! 688 INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:689 672 ! local number of points for x,y dimensions 690 673 ! position of first local point for x,y dimensions … … 718 701 ELSE ; lliof = .FALSE. 719 702 ENDIF 720 ! do we read the overlap721 ! ugly patch SM+JMM+RB to overwrite global definition in some cases722 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif723 703 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 724 704 ! ============= … … 760 740 lxios_sini = .TRUE. 761 741 ENDIF 762 IF( llwrt ) THEN763 ! check the domain definition764 ! JMM + SM: ugly patch before getting the new version of lib_mpp)765 ! idom = jpdom_local_noovlap ! default definition766 IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition767 ELSE ; idom = jpdom_local_full ! default definition768 ENDIF769 IF( PRESENT(kdom) ) idom = kdom770 ! create the domain informations771 ! =============772 SELECT CASE (idom)773 CASE (jpdom_local_full)774 idompar(:,1) = (/ jpi , jpj /)775 idompar(:,2) = (/ nimpp , njmpp /)776 idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /)777 idompar(:,4) = (/ nldi - 1 , nldj - 1 /)778 idompar(:,5) = (/ jpi - nlei , jpj - nlej /)779 CASE (jpdom_local_noextra)780 idompar(:,1) = (/ nlci , nlcj /)781 idompar(:,2) = (/ nimpp , njmpp /)782 idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)783 idompar(:,4) = (/ nldi - 1 , nldj - 1 /)784 idompar(:,5) = (/ nlci - nlei , nlcj - nlej /)785 CASE (jpdom_local_noovlap)786 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /)787 idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)788 idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)789 idompar(:,4) = (/ 0 , 0 /)790 idompar(:,5) = (/ 0 , 0 /)791 CASE DEFAULT792 CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )793 END SELECT794 ENDIF795 742 ! Open the NetCDF file 796 743 ! ============= … … 816 763 ENDIF 817 764 IF( istop == nstop ) THEN ! no error within this routine 818 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev)765 CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 819 766 ENDIF 820 767 ! … … 934 881 !! INTERFACE iom_get 935 882 !!---------------------------------------------------------------------- 936 SUBROUTINE iom_g0d ( kiomid, cdvar, pvar, ktime, ldxios )883 SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 937 884 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 938 885 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 939 REAL(wp) , INTENT( out) :: pvar ! read field 886 REAL(sp) , INTENT( out) :: pvar ! read field 887 REAL(dp) :: ztmp_pvar ! tmp var to read field 888 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 889 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 890 ! 891 INTEGER :: idvar ! variable id 892 INTEGER :: idmspc ! number of spatial dimensions 893 INTEGER , DIMENSION(1) :: itime ! record number 894 CHARACTER(LEN=100) :: clinfo ! info character 895 CHARACTER(LEN=100) :: clname ! file name 896 CHARACTER(LEN=1) :: cldmspc ! 897 LOGICAL :: llxios 898 ! 899 llxios = .FALSE. 900 IF( PRESENT(ldxios) ) llxios = ldxios 901 902 IF(.NOT.llxios) THEN ! read data using default library 903 itime = 1 904 IF( PRESENT(ktime) ) itime = ktime 905 ! 906 clname = iom_file(kiomid)%name 907 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 908 ! 909 IF( kiomid > 0 ) THEN 910 idvar = iom_varid( kiomid, cdvar ) 911 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 912 idmspc = iom_file ( kiomid )%ndims( idvar ) 913 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 914 WRITE(cldmspc , fmt='(i1)') idmspc 915 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 916 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 917 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 918 CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 919 pvar = ztmp_pvar 920 ENDIF 921 ENDIF 922 ELSE 923 #if defined key_iomput 924 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 925 CALL iom_swap( TRIM(crxios_context) ) 926 CALL xios_recv_field( trim(cdvar), pvar) 927 CALL iom_swap( TRIM(cxios_context) ) 928 #else 929 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 930 CALL ctl_stop( 'iom_g0d', ctmp1 ) 931 #endif 932 ENDIF 933 END SUBROUTINE iom_g0d_sp 934 935 SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 936 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 937 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 938 REAL(dp) , INTENT( out) :: pvar ! read field 940 939 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 941 940 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart … … 982 981 #endif 983 982 ENDIF 984 END SUBROUTINE iom_g0d 985 986 SUBROUTINE iom_g1d ( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )983 END SUBROUTINE iom_g0d_dp 984 985 SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 987 986 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 988 987 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 989 988 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 990 REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field 989 REAL(sp) , INTENT( out), DIMENSION(:) :: pvar ! read field 990 REAL(dp) , ALLOCATABLE , DIMENSION(:) :: ztmp_pvar ! tmp var to read field 991 991 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 992 992 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading … … 995 995 ! 996 996 IF( kiomid > 0 ) THEN 997 IF( iom_file(kiomid)%nfid > 0 ) THEN 998 ALLOCATE(ztmp_pvar(size(pvar,1))) 999 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=ztmp_pvar, & 1000 & ktime=ktime, kstart=kstart, kcount=kcount, & 1001 & ldxios=ldxios ) 1002 pvar = ztmp_pvar 1003 DEALLOCATE(ztmp_pvar) 1004 END IF 1005 ENDIF 1006 END SUBROUTINE iom_g1d_sp 1007 1008 1009 SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 1010 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1011 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1012 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1013 REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1014 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1015 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1016 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1017 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1018 ! 1019 IF( kiomid > 0 ) THEN 997 1020 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 998 1021 & ktime=ktime, kstart=kstart, kcount=kcount, & 999 1022 & ldxios=ldxios ) 1000 1023 ENDIF 1001 END SUBROUTINE iom_g1d 1002 1003 SUBROUTINE iom_g2d ( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios)1004 INTEGER , INTENT(in ) 1005 INTEGER , INTENT(in ) 1006 CHARACTER(len=*), INTENT(in ) 1007 REAL( wp) , INTENT( out), DIMENSION(:,:):: pvar ! read field1008 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number1009 INTEGER , INTENT(in ) , DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading1010 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis1011 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to1012 ! look for and use a file attribute1013 ! called open_ocean_jstart to set the start1014 ! value for the 2nd dimension (netcdf only)1015 LOGICAL , INTENT(in ), OPTIONAL :: ldxios 1024 END SUBROUTINE iom_g1d_dp 1025 1026 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1027 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1028 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1029 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1030 REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1031 REAL(dp) , ALLOCATABLE , DIMENSION(:,:) :: ztmp_pvar ! tmp var to read field 1032 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1033 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1034 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1035 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1036 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1037 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1038 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1016 1039 ! 1017 1040 IF( kiomid > 0 ) THEN 1018 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 1019 & ktime=ktime, kstart=kstart, kcount=kcount, & 1020 & lrowattr=lrowattr, ldxios=ldxios) 1021 ENDIF 1022 END SUBROUTINE iom_g2d 1023 1024 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 1025 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1026 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1027 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1028 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1029 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1030 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 1031 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 1032 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1033 ! look for and use a file attribute 1034 ! called open_ocean_jstart to set the start 1035 ! value for the 2nd dimension (netcdf only) 1036 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1041 IF( iom_file(kiomid)%nfid > 0 ) THEN 1042 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 1043 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1044 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1045 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1046 pvar = ztmp_pvar 1047 DEALLOCATE(ztmp_pvar) 1048 ENDIF 1049 ENDIF 1050 END SUBROUTINE iom_g2d_sp 1051 1052 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1053 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1054 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1055 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1056 REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1057 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1058 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1059 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1060 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1061 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1062 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1063 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1037 1064 ! 1038 1065 IF( kiomid > 0 ) THEN 1039 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 1040 & ktime=ktime, kstart=kstart, kcount=kcount, & 1041 & lrowattr=lrowattr, ldxios=ldxios ) 1042 ENDIF 1043 END SUBROUTINE iom_g3d 1066 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1067 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1068 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1069 ENDIF 1070 END SUBROUTINE iom_g2d_dp 1071 1072 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 1073 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1074 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1075 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1076 REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1077 REAL(dp) , ALLOCATABLE , DIMENSION(:,:,:) :: ztmp_pvar ! tmp var to read field 1078 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1079 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1080 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1081 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1082 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1083 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1084 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1085 ! 1086 IF( kiomid > 0 ) THEN 1087 IF( iom_file(kiomid)%nfid > 0 ) THEN 1088 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 1089 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1090 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1091 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1092 pvar = ztmp_pvar 1093 DEALLOCATE(ztmp_pvar) 1094 END IF 1095 ENDIF 1096 END SUBROUTINE iom_g3d_sp 1097 1098 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 1099 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1100 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1101 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1102 REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1103 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1104 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1105 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1106 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1107 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1108 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1109 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1110 ! 1111 IF( kiomid > 0 ) THEN 1112 IF( iom_file(kiomid)%nfid > 0 ) THEN 1113 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1114 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1115 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1116 END IF 1117 ENDIF 1118 END SUBROUTINE iom_g3d_dp 1119 1044 1120 !!---------------------------------------------------------------------- 1045 1121 1046 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 1047 & pv_r1d, pv_r2d, pv_r3d, & 1048 & ktime , kstart, kcount, & 1049 & lrowattr, ldxios ) 1122 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1123 & cd_type, psgn, kfill, kstart, kcount, ldxios ) 1050 1124 !!----------------------------------------------------------------------- 1051 1125 !! *** ROUTINE iom_get_123d *** … … 1055 1129 !! ** Method : read ONE record at each CALL 1056 1130 !!----------------------------------------------------------------------- 1057 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1058 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1059 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1060 REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1061 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1062 REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1063 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1064 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1065 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1066 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 1067 ! look for and use a file attribute 1068 ! called open_ocean_jstart to set the start 1069 ! value for the 2nd dimension (netcdf only) 1070 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1071 ! 1072 LOGICAL :: llxios ! local definition for XIOS read 1073 LOGICAL :: llnoov ! local definition to read overlap 1074 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 1075 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 1131 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1132 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1133 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1134 REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1135 REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1136 REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1137 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1138 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1139 REAL(dp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1140 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1141 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1142 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1143 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1144 ! 1145 LOGICAL :: llok ! true if ok! 1146 LOGICAL :: llxios ! local definition for XIOS read 1076 1147 INTEGER :: jl ! loop on number of dimension 1077 1148 INTEGER :: idom ! type of domain … … 1089 1160 INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable 1090 1161 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1091 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 1162 REAL(dp) :: zscf, zofs ! sacle_factor and add_offset 1163 REAL(wp) :: zsgn ! local value of psgn 1092 1164 INTEGER :: itmp ! temporary integer 1093 1165 CHARACTER(LEN=256) :: clinfo ! info character 1094 1166 CHARACTER(LEN=256) :: clname ! file name 1095 1167 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1096 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1168 CHARACTER(LEN=1) :: cl_type ! local value of cd_type 1169 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1097 1170 INTEGER :: inlev ! number of levels for 3D data 1098 REAL( wp) :: gma, gmi1171 REAL(dp) :: gma, gmi 1099 1172 !--------------------------------------------------------------------- 1100 1173 ! … … 1103 1176 ! 1104 1177 llxios = .FALSE. 1105 if(PRESENT(ldxios))llxios = ldxios1106 idvar = iom_varid( kiomid, cdvar )1178 IF( PRESENT(ldxios) ) llxios = ldxios 1179 ! 1107 1180 idom = kdom 1181 istop = nstop 1108 1182 ! 1109 1183 IF(.NOT.llxios) THEN 1110 1184 clname = iom_file(kiomid)%name ! esier to read 1111 1185 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1112 ! local definition of the domain ?1113 ! do we read the overlap1114 ! ugly patch SM+JMM+RB to overwrite global definition in some cases1115 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif1116 1186 ! check kcount and kstart optionals parameters... 1117 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1118 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1119 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1120 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1121 1122 luse_jattr = .false. 1123 IF( PRESENT(lrowattr) ) THEN 1124 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1125 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1126 ENDIF 1127 1187 IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1188 IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1189 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 1190 & CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 1191 IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) & 1192 & CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present') 1193 ! 1128 1194 ! Search for the variable in the data base (eventually actualize data) 1129 istop = nstop1130 1195 ! 1196 idvar = iom_varid( kiomid, cdvar ) 1131 1197 IF( idvar > 0 ) THEN 1132 ! to write iom_file(kiomid)%dimsz in a shorter way !1133 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1198 ! 1199 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) ! to write iom_file(kiomid)%dimsz in a shorter way 1134 1200 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1135 1201 idmspc = inbdim ! number of spatial dimensions in the file … … 1137 1203 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1138 1204 ! 1139 ! update idom definition... 1140 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1141 IF( idom == jpdom_autoglo_xy ) THEN 1142 ll_depth_spec = .TRUE. 1143 idom = jpdom_autoglo 1144 ELSE 1145 ll_depth_spec = .FALSE. 1146 ENDIF 1147 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1148 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1149 ELSE ; idom = jpdom_data 1150 ENDIF 1205 ! Identify the domain in case of jpdom_auto definition 1206 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1207 idom = jpdom_global ! default 1208 ! else: if the file name finishes with _xxxx.nc with xxxx any number 1151 1209 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1152 1210 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1153 1211 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 1154 ENDIF1155 ! Identify the domain in case of jpdom_local definition1156 IF( idom == jpdom_local ) THEN1157 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full1158 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra1159 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap1160 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )1161 ENDIF1162 1212 ENDIF 1163 1213 ! … … 1172 1222 WRITE(cldmspc , fmt='(i1)') idmspc 1173 1223 ! 1174 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1175 !IF( idmspc < irankpv ) THEN 1176 ! CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1177 ! & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1178 !ELSEIF( idmspc == irankpv ) THEN 1179 IF( idmspc == irankpv ) THEN 1224 IF( idmspc < irankpv ) THEN ! it seems we want to read more than we can... 1225 IF( irankpv == 3 .AND. idmspc == 2 ) THEN ! 3D input array from 2D spatial data in the file: 1226 llok = inlev == 1 ! -> 3rd dimension must be equal to 1 1227 ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN ! 3D input array from 1D spatial data in the file: 1228 llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1 ! -> 2nd and 3rd dimensions must be equal to 1 1229 ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN ! 2D input array from 1D spatial data in the file: 1230 llok = SIZE(pv_r2d, 2) == 1 ! -> 2nd dimension must be equal to 1 1231 ELSE 1232 llok = .FALSE. 1233 ENDIF 1234 IF( .NOT. llok ) CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1235 & '=> cannot read a true '//clrankpv//'D array from this file...' ) 1236 ELSEIF( idmspc == irankpv ) THEN 1180 1237 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1181 1238 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1182 ELSEIF( idmspc > irankpv ) THEN 1239 ELSEIF( idmspc > irankpv ) THEN ! it seems we want to read less than we should... 1183 1240 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1184 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &1241 CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...' , & 1185 1242 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1186 1243 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1187 1244 idmspc = idmspc - 1 1188 ELSE 1189 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1190 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1191 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1245 !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 1246 !ELSE 1247 ! CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,', & 1248 ! & 'we do not accept data with '//cldmspc//' spatial dimensions' , & 1249 ! & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1192 1250 ENDIF 1193 1251 ENDIF … … 1195 1253 ! definition of istart and icnt 1196 1254 ! 1197 icnt (:) = 1 1198 istart(:) = 1 1199 istart(idmspc+1) = itime 1200 1201 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 1202 istart(1:idmspc) = kstart(1:idmspc) 1203 icnt (1:idmspc) = kcount(1:idmspc) 1204 ELSE 1205 IF(idom == jpdom_unknown ) THEN 1206 icnt(1:idmspc) = idimsz(1:idmspc) 1207 ELSE 1208 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 1209 IF( idom == jpdom_data ) THEN 1210 jstartrow = 1 1211 IF( luse_jattr ) THEN 1212 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 1213 jstartrow = MAX(1,jstartrow) 1214 ENDIF 1215 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 1216 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 1217 ENDIF 1218 ! we do not read the overlap -> we start to read at nldi, nldj 1219 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1220 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1221 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1222 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 1223 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1224 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1225 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1226 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 1227 ENDIF 1228 IF( PRESENT(pv_r3d) ) THEN 1229 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 1230 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1231 ELSE ; icnt(3) = inlev 1232 ENDIF 1233 ENDIF 1255 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1256 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1257 istart(idmspc+1) = itime ! temporal dimenstion 1258 ! 1259 IF( idom == jpdom_unknown ) THEN 1260 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1261 istart(1:idmspc) = kstart(1:idmspc) 1262 icnt (1:idmspc) = kcount(1:idmspc) 1263 ELSE 1264 icnt (1:idmspc) = idimsz(1:idmspc) 1265 ENDIF 1266 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1267 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1268 IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 1269 icnt(1:2) = (/ Ni_0, Nj_0 /) 1270 IF( PRESENT(pv_r3d) ) THEN 1271 IF( idom == jpdom_auto_xy ) THEN 1272 istart(3) = kstart(3) 1273 icnt (3) = kcount(3) 1274 ELSE 1275 icnt (3) = inlev 1234 1276 ENDIF 1235 1277 ENDIF 1236 1278 ENDIF 1237 1279 ! 1238 1280 ! check that istart and icnt can be used with this file 1239 1281 !- … … 1246 1288 ENDIF 1247 1289 END DO 1248 1290 ! 1249 1291 ! check that icnt matches the input array 1250 1292 !- … … 1256 1298 ELSE 1257 1299 IF( irankpv == 2 ) THEN 1258 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1259 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 1260 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1261 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1262 ENDIF 1300 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1263 1301 ENDIF 1264 1302 IF( irankpv == 3 ) THEN 1265 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1266 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1267 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1268 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1269 ENDIF 1303 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1270 1304 ENDIF 1271 ENDIF 1272 1305 ENDIF 1273 1306 DO jl = 1, irankpv 1274 1307 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) … … 1282 1315 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1283 1316 ! 1284 ! find the right index of the array to be read 1285 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1286 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1287 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1288 ! ENDIF 1289 IF( llnoov ) THEN 1290 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1291 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1292 ENDIF 1293 ELSE 1294 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1295 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1296 ENDIF 1317 ! find the right index of the array to be read 1318 IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 1319 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1297 1320 ENDIF 1298 1321 … … 1301 1324 IF( istop == nstop ) THEN ! no additional errors until this point... 1302 1325 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1303 1326 1327 cl_type = 'T' 1328 IF( PRESENT(cd_type) ) cl_type = cd_type 1329 zsgn = 1._wp 1330 IF( PRESENT(psgn ) ) zsgn = psgn 1304 1331 !--- overlap areas and extra hallows (mpp) 1305 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1306 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 1307 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1308 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1309 IF( icnt(3) == inlev ) THEN 1310 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 1311 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1312 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1313 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1314 ENDIF 1332 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1333 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 1334 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1335 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 1315 1336 ENDIF 1316 1337 ! … … 1329 1350 CALL iom_swap( TRIM(crxios_context) ) 1330 1351 IF( PRESENT(pv_r3d) ) THEN 1331 pv_r3d(:, :, :) = 0. 1332 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1352 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1333 1353 CALL xios_recv_field( trim(cdvar), pv_r3d) 1334 IF(idom /= jpdom_unknown ) then 1335 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1336 ENDIF 1354 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1337 1355 ELSEIF( PRESENT(pv_r2d) ) THEN 1338 pv_r2d(:, :) = 0. 1339 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1356 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1340 1357 CALL xios_recv_field( trim(cdvar), pv_r2d) 1341 IF(idom /= jpdom_unknown ) THEN 1342 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1343 ENDIF 1358 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1344 1359 ELSEIF( PRESENT(pv_r1d) ) THEN 1345 pv_r1d(:) = 0. 1346 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1360 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1347 1361 CALL xios_recv_field( trim(cdvar), pv_r1d) 1348 1362 ENDIF … … 1355 1369 !some final adjustments 1356 1370 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1357 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1. )1358 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1. )1371 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 1372 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 1359 1373 1360 1374 !--- Apply scale_factor and offset … … 1543 1557 !! INTERFACE iom_rstput 1544 1558 !!---------------------------------------------------------------------- 1545 SUBROUTINE iom_rp0d ( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1559 SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1546 1560 INTEGER , INTENT(in) :: kt ! ocean time-step 1547 1561 INTEGER , INTENT(in) :: kwrite ! writing time-step 1548 1562 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1549 1563 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1550 REAL( wp) , INTENT(in) :: pvar ! written field1564 REAL(sp) , INTENT(in) :: pvar ! written field 1551 1565 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1552 1566 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1567 1581 IF( iom_file(kiomid)%nfid > 0 ) THEN 1568 1582 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1569 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar)1583 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 1570 1584 ENDIF 1571 1585 ENDIF 1572 1586 ENDIF 1573 END SUBROUTINE iom_rp0d 1574 1575 SUBROUTINE iom_rp 1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1587 END SUBROUTINE iom_rp0d_sp 1588 1589 SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1576 1590 INTEGER , INTENT(in) :: kt ! ocean time-step 1577 1591 INTEGER , INTENT(in) :: kwrite ! writing time-step 1578 1592 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1579 1593 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1580 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1594 REAL(dp) , INTENT(in) :: pvar ! written field 1595 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1596 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1597 LOGICAL :: llx ! local xios write flag 1598 INTEGER :: ivid ! variable id 1599 1600 llx = .FALSE. 1601 IF(PRESENT(ldxios)) llx = ldxios 1602 IF( llx ) THEN 1603 #ifdef key_iomput 1604 IF( kt == kwrite ) THEN 1605 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1606 CALL xios_send_field(trim(cdvar), pvar) 1607 ENDIF 1608 #endif 1609 ELSE 1610 IF( kiomid > 0 ) THEN 1611 IF( iom_file(kiomid)%nfid > 0 ) THEN 1612 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1613 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1614 ENDIF 1615 ENDIF 1616 ENDIF 1617 END SUBROUTINE iom_rp0d_dp 1618 1619 1620 SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1621 INTEGER , INTENT(in) :: kt ! ocean time-step 1622 INTEGER , INTENT(in) :: kwrite ! writing time-step 1623 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1624 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1625 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1581 1626 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1582 1627 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1597 1642 IF( iom_file(kiomid)%nfid > 0 ) THEN 1598 1643 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1599 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar)1644 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 1600 1645 ENDIF 1601 1646 ENDIF 1602 1647 ENDIF 1603 END SUBROUTINE iom_rp1d 1604 1605 SUBROUTINE iom_rp 2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1648 END SUBROUTINE iom_rp1d_sp 1649 1650 SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1606 1651 INTEGER , INTENT(in) :: kt ! ocean time-step 1607 1652 INTEGER , INTENT(in) :: kwrite ! writing time-step 1608 1653 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1609 1654 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1610 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1655 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1656 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1657 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1658 LOGICAL :: llx ! local xios write flag 1659 INTEGER :: ivid ! variable id 1660 1661 llx = .FALSE. 1662 IF(PRESENT(ldxios)) llx = ldxios 1663 IF( llx ) THEN 1664 #ifdef key_iomput 1665 IF( kt == kwrite ) THEN 1666 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1667 CALL xios_send_field(trim(cdvar), pvar) 1668 ENDIF 1669 #endif 1670 ELSE 1671 IF( kiomid > 0 ) THEN 1672 IF( iom_file(kiomid)%nfid > 0 ) THEN 1673 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1674 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1675 ENDIF 1676 ENDIF 1677 ENDIF 1678 END SUBROUTINE iom_rp1d_dp 1679 1680 1681 SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1682 INTEGER , INTENT(in) :: kt ! ocean time-step 1683 INTEGER , INTENT(in) :: kwrite ! writing time-step 1684 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1685 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1686 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1611 1687 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1612 1688 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1627 1703 IF( iom_file(kiomid)%nfid > 0 ) THEN 1628 1704 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1629 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar)1705 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 1630 1706 ENDIF 1631 1707 ENDIF 1632 1708 ENDIF 1633 END SUBROUTINE iom_rp2d 1634 1635 SUBROUTINE iom_rp 3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )1709 END SUBROUTINE iom_rp2d_sp 1710 1711 SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1636 1712 INTEGER , INTENT(in) :: kt ! ocean time-step 1637 1713 INTEGER , INTENT(in) :: kwrite ! writing time-step 1638 1714 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1639 1715 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1640 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1716 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1717 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1718 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1719 LOGICAL :: llx 1720 INTEGER :: ivid ! variable id 1721 1722 llx = .FALSE. 1723 IF(PRESENT(ldxios)) llx = ldxios 1724 IF( llx ) THEN 1725 #ifdef key_iomput 1726 IF( kt == kwrite ) THEN 1727 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1728 CALL xios_send_field(trim(cdvar), pvar) 1729 ENDIF 1730 #endif 1731 ELSE 1732 IF( kiomid > 0 ) THEN 1733 IF( iom_file(kiomid)%nfid > 0 ) THEN 1734 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1735 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1736 ENDIF 1737 ENDIF 1738 ENDIF 1739 END SUBROUTINE iom_rp2d_dp 1740 1741 1742 SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1743 INTEGER , INTENT(in) :: kt ! ocean time-step 1744 INTEGER , INTENT(in) :: kwrite ! writing time-step 1745 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1746 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1747 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1641 1748 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1642 1749 LOGICAL, OPTIONAL :: ldxios ! xios write flag … … 1657 1764 IF( iom_file(kiomid)%nfid > 0 ) THEN 1658 1765 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1766 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 1767 ENDIF 1768 ENDIF 1769 ENDIF 1770 END SUBROUTINE iom_rp3d_sp 1771 1772 SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1773 INTEGER , INTENT(in) :: kt ! ocean time-step 1774 INTEGER , INTENT(in) :: kwrite ! writing time-step 1775 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1776 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1777 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1778 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1779 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1780 LOGICAL :: llx ! local xios write flag 1781 INTEGER :: ivid ! variable id 1782 1783 llx = .FALSE. 1784 IF(PRESENT(ldxios)) llx = ldxios 1785 IF( llx ) THEN 1786 #ifdef key_iomput 1787 IF( kt == kwrite ) THEN 1788 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1789 CALL xios_send_field(trim(cdvar), pvar) 1790 ENDIF 1791 #endif 1792 ELSE 1793 IF( kiomid > 0 ) THEN 1794 IF( iom_file(kiomid)%nfid > 0 ) THEN 1795 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1659 1796 CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1660 1797 ENDIF 1661 1798 ENDIF 1662 1799 ENDIF 1663 END SUBROUTINE iom_rp3d 1800 END SUBROUTINE iom_rp3d_dp 1801 1664 1802 1665 1803 … … 1713 1851 !! INTERFACE iom_put 1714 1852 !!---------------------------------------------------------------------- 1715 SUBROUTINE iom_p0d ( cdname, pfield0d )1853 SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 1716 1854 CHARACTER(LEN=*), INTENT(in) :: cdname 1717 REAL( wp) , INTENT(in) :: pfield0d1855 REAL(sp) , INTENT(in) :: pfield0d 1718 1856 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1719 1857 #if defined key_iomput … … 1724 1862 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 1725 1863 #endif 1726 END SUBROUTINE iom_p0d 1727 1728 SUBROUTINE iom_p1d( cdname, pfield1d ) 1864 END SUBROUTINE iom_p0d_sp 1865 1866 SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 1867 CHARACTER(LEN=*), INTENT(in) :: cdname 1868 REAL(dp) , INTENT(in) :: pfield0d 1869 !! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1870 #if defined key_iomput 1871 !!clem zz(:,:)=pfield0d 1872 !!clem CALL xios_send_field(cdname, zz) 1873 CALL xios_send_field(cdname, (/pfield0d/)) 1874 #else 1875 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings 1876 #endif 1877 END SUBROUTINE iom_p0d_dp 1878 1879 1880 SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 1729 1881 CHARACTER(LEN=*) , INTENT(in) :: cdname 1730 REAL( wp), DIMENSION(:), INTENT(in) :: pfield1d1882 REAL(sp), DIMENSION(:), INTENT(in) :: pfield1d 1731 1883 #if defined key_iomput 1732 1884 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) … … 1734 1886 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 1735 1887 #endif 1736 END SUBROUTINE iom_p1d 1737 1738 SUBROUTINE iom_p2d( cdname, pfield2d ) 1888 END SUBROUTINE iom_p1d_sp 1889 1890 SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 1891 CHARACTER(LEN=*) , INTENT(in) :: cdname 1892 REAL(dp), DIMENSION(:), INTENT(in) :: pfield1d 1893 #if defined key_iomput 1894 CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 1895 #else 1896 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 1897 #endif 1898 END SUBROUTINE iom_p1d_dp 1899 1900 SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 1739 1901 CHARACTER(LEN=*) , INTENT(in) :: cdname 1740 REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d 1741 #if defined key_iomput 1742 CALL xios_send_field(cdname, pfield2d) 1902 REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d 1903 IF( iom_use(cdname) ) THEN 1904 #if defined key_iomput 1905 IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 1906 CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) ) ! this extraction will create a copy of pfield2d 1907 ELSE 1908 CALL xios_send_field( cdname, pfield2d ) 1909 ENDIF 1743 1910 #else 1744 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 1745 #endif 1746 END SUBROUTINE iom_p2d 1747 1748 SUBROUTINE iom_p3d( cdname, pfield3d ) 1911 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1912 #endif 1913 ENDIF 1914 END SUBROUTINE iom_p2d_sp 1915 1916 SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 1917 CHARACTER(LEN=*) , INTENT(in) :: cdname 1918 REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d 1919 IF( iom_use(cdname) ) THEN 1920 #if defined key_iomput 1921 IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 1922 CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) ) ! this extraction will create a copy of pfield2d 1923 ELSE 1924 CALL xios_send_field( cdname, pfield2d ) 1925 ENDIF 1926 #else 1927 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1928 #endif 1929 ENDIF 1930 END SUBROUTINE iom_p2d_dp 1931 1932 SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 1749 1933 CHARACTER(LEN=*) , INTENT(in) :: cdname 1750 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1751 #if defined key_iomput 1752 CALL xios_send_field( cdname, pfield3d ) 1934 REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1935 IF( iom_use(cdname) ) THEN 1936 #if defined key_iomput 1937 IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 1938 CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) ) ! this extraction will create a copy of pfield3d 1939 ELSE 1940 CALL xios_send_field( cdname, pfield3d ) 1941 ENDIF 1753 1942 #else 1754 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 1755 #endif 1756 END SUBROUTINE iom_p3d 1757 1758 SUBROUTINE iom_p4d( cdname, pfield4d ) 1943 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1944 #endif 1945 ENDIF 1946 END SUBROUTINE iom_p3d_sp 1947 1948 SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 1759 1949 CHARACTER(LEN=*) , INTENT(in) :: cdname 1760 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1761 #if defined key_iomput 1762 CALL xios_send_field(cdname, pfield4d) 1950 REAL(dp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1951 IF( iom_use(cdname) ) THEN 1952 #if defined key_iomput 1953 IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 1954 CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) ) ! this extraction will create a copy of pfield3d 1955 ELSE 1956 CALL xios_send_field( cdname, pfield3d ) 1957 ENDIF 1763 1958 #else 1764 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 1765 #endif 1766 END SUBROUTINE iom_p4d 1767 1959 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1960 #endif 1961 ENDIF 1962 END SUBROUTINE iom_p3d_dp 1963 1964 SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 1965 CHARACTER(LEN=*) , INTENT(in) :: cdname 1966 REAL(sp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1967 IF( iom_use(cdname) ) THEN 1968 #if defined key_iomput 1969 IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 1970 CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) ) ! this extraction will create a copy of pfield4d 1971 ELSE 1972 CALL xios_send_field (cdname, pfield4d ) 1973 ENDIF 1974 #else 1975 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1976 #endif 1977 ENDIF 1978 END SUBROUTINE iom_p4d_sp 1979 1980 SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 1981 CHARACTER(LEN=*) , INTENT(in) :: cdname 1982 REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1983 IF( iom_use(cdname) ) THEN 1984 #if defined key_iomput 1985 IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 1986 CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) ) ! this extraction will create a copy of pfield4d 1987 ELSE 1988 CALL xios_send_field (cdname, pfield4d ) 1989 ENDIF 1990 #else 1991 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1992 #endif 1993 ENDIF 1994 END SUBROUTINE iom_p4d_dp 1768 1995 1769 1996 #if defined key_iomput … … 1781 2008 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1782 2009 INTEGER , OPTIONAL, INTENT(in) :: nvertex 1783 REAL( wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue1784 REAL( wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area2010 REAL(dp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 2011 REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1785 2012 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1786 2013 !!---------------------------------------------------------------------- … … 1845 2072 !!---------------------------------------------------------------------- 1846 2073 IF( PRESENT(paxis) ) THEN 1847 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1848 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1849 ENDIF 1850 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1851 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 2074 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2075 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 2076 ENDIF 2077 IF( PRESENT(bounds) ) THEN 2078 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=real(bounds, dp) ) 2079 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 2080 ELSE 2081 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid) 2082 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid) 2083 END IF 1852 2084 CALL xios_solve_inheritance() 1853 2085 END SUBROUTINE iom_set_axis_attr … … 1956 2188 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1957 2189 ! 1958 INTEGER :: ni, nj1959 2190 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1960 2191 LOGICAL, INTENT(IN) :: ldxios, ldrxios 1961 2192 !!---------------------------------------------------------------------- 1962 2193 ! 1963 ni = nlei-nldi+1 1964 nj = nlej-nldj+1 1965 ! 1966 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1967 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 2194 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 2195 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 1968 2196 !don't define lon and lat for restart reading context. 1969 2197 IF ( .NOT.ldrxios ) & 1970 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &1971 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))2198 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp), & 2199 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 1972 2200 ! 1973 2201 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 1975 2203 SELECT CASE ( cdgrd ) 1976 2204 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1977 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( 'iom', zmask, 'U', 1. )1978 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( 'iom', zmask, 'V', 1. )2205 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 2206 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 1979 2207 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1980 2208 END SELECT 1981 2209 ! 1982 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,1),(/ni*nj/)) /= 0. )1983 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )2210 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. ) 2211 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 1984 2212 ENDIF 1985 2213 ! 1986 2214 END SUBROUTINE set_grid 1987 1988 2215 1989 2216 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) … … 1998 2225 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1999 2226 ! 2000 INTEGER :: ji, jj, jn , ni, nj2227 INTEGER :: ji, jj, jn 2001 2228 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 2002 ! ! represents the bottom-left corner of cell (i,j) 2229 ! ! represents the 2230 ! bottom-left corner of 2231 ! cell (i,j) 2003 2232 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 2004 2233 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells … … 2015 2244 END SELECT 2016 2245 ! 2017 ni = nlei-nldi+1 ! Dimensions of subdomain interior2018 nj = nlej-nldj+12019 !2020 2246 z_fld(:,:) = 1._wp 2021 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. ) ! Working array for location of northfold2247 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp ) ! Working array for location of northfold 2022 2248 ! 2023 2249 ! Cell vertices that can be defined 2024 DO jj = 2, jpjm1 2025 DO ji = 2, jpim1 2026 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2027 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2028 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2029 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2030 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2031 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2032 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2033 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2034 END DO 2035 END DO 2036 ! 2037 ! Cell vertices on boundries 2038 DO jn = 1, 4 2039 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 2040 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 2041 END DO 2042 ! 2043 ! Zero-size cells at closed boundaries if cell points provided, 2044 ! otherwise they are closed cells with unrealistic bounds 2045 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 2046 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 2047 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 2048 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 2049 END DO 2050 ENDIF 2051 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 2052 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 2053 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 2054 END DO 2055 ENDIF 2056 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 2057 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 2058 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 2059 END DO 2060 ENDIF 2061 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 2062 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 2063 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 2064 END DO 2065 ENDIF 2066 ENDIF 2067 ! 2068 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN ! Rotate cells at the north fold 2069 DO jj = 1, jpj 2070 DO ji = 1, jpi 2071 IF( z_fld(ji,jj) == -1. ) THEN 2072 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 2073 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 2074 z_bnds(:,ji,jj,:) = z_rot(:,:) 2075 ENDIF 2076 END DO 2077 END DO 2078 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN ! Invert cells at the symmetric equator 2079 DO ji = 1, jpi 2080 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 2081 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 2082 z_bnds(:,ji,1,:) = z_rot(:,:) 2083 END DO 2084 ENDIF 2085 ! 2086 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 2087 & bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 2088 ! 2089 DEALLOCATE( z_bnds, z_fld, z_rot ) 2250 DO_2D( 0, 0, 0, 0 ) 2251 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2252 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2253 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2254 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2255 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2256 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2257 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2258 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2259 END_2D 2260 ! 2261 DO_2D( 0, 0, 0, 0 ) 2262 IF( z_fld(ji,jj) == -1. ) THEN 2263 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 2264 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 2265 z_bnds(:,ji,jj,:) = z_rot(:,:) 2266 ENDIF 2267 END_2D 2268 ! 2269 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp), & 2270 & bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 2271 ! 2272 DEALLOCATE( z_bnds, z_fld, z_rot ) 2090 2273 ! 2091 2274 END SUBROUTINE set_grid_bounds 2092 2275 2093 2094 2276 SUBROUTINE set_grid_znl( plat ) 2095 2277 !!---------------------------------------------------------------------- … … 2101 2283 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2102 2284 ! 2103 INTEGER :: ni, nj,ix, iy2285 INTEGER :: ix, iy 2104 2286 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2105 2287 !!---------------------------------------------------------------------- 2106 2288 ! 2107 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) 2108 nj=nlej-nldj+1 2109 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2110 ! 2111 ! CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2112 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2113 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 2114 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 2115 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 2116 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 2117 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2289 ALLOCATE( zlon(Ni_0*Nj_0) ) ; zlon(:) = 0._wp 2290 ! 2291 ! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2292 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) 2293 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) 2294 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 2295 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2296 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2297 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 2118 2298 ! 2119 2299 CALL iom_update_file_name('ptr') … … 2129 2309 !! 2130 2310 !!---------------------------------------------------------------------- 2131 REAL( wp), DIMENSION(1) :: zz = 1.2311 REAL(dp), DIMENSION(1) :: zz = 1. 2132 2312 !!---------------------------------------------------------------------- 2133 2313 ! … … 2191 2371 cl1 = clgrd(jg) 2192 2372 ! Equatorial section (attributs: jbegin, ni, name_suffix) 2193 CALL dom_ngb( 0. , 0., ix, iy, cl1 )2194 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni= jpiglo, nj=1 )2373 CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 2374 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 2195 2375 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 2196 2376 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 2417 2597 ! 2418 2598 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 2419 CALL ju2ymds( pjday - 1. , iyear, imonth, iday, zsec )2599 CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 2420 2600 isec = 86400 2421 2601 ENDIF … … 2475 2655 CHARACTER(LEN=*), INTENT(in ) :: cdname 2476 2656 REAL(wp) , INTENT(out) :: pmiss_val 2657 REAL(dp) :: ztmp_pmiss_val 2477 2658 #if defined key_iomput 2478 2659 ! get missing value 2479 CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 2660 CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 2661 pmiss_val = ztmp_pmiss_val 2480 2662 #else 2481 2663 IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings
Note: See TracChangeset
for help on using the changeset viewer.
