- Timestamp:
- 12/03/18 16:45:53 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
TOOLS/MOSAIX/src/MOSAIX/interpol.f90
r4153 r4167 22 22 CHARACTER (LEN=20) :: nchar, type_src, type_dst 23 23 LOGICAL :: l_mask_src = .TRUE. , l_mask_dst = .TRUE., l_use_area = .FALSE. 24 LOGICAL :: l_src_is2D = .FALSE., l_src_is1D = .FALSE., l_src_is0D = .FALSE., l_dst_is2D = .FALSE. , l_dst_is1D = .FALSE., l_dst_is0D = .FALSE. 24 25 ! 25 26 REAL (kind=rl), PARAMETER :: rpi = ACOS ( -1.0_rl) … … 99 100 SELECT CASE ( TRIM (type_src)) 100 101 CASE ( "rectilinear" ) 102 l_src_is2D = .TRUE. 101 103 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src rectilinear', 6I9)") rank 102 104 CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(1,:) ) … … 104 106 lat_src (:,:) = SPREAD ( lat_src(1,:), DIM=1, ncopies=nj_src) 105 107 CASE default 106 IF ( nj_src == 1 .AND. ni_src==1) THEN 107 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank 108 IF ( nj_src == 1 .AND. ni_src == 1) THEN 109 l_src_is0D = .TRUE. 110 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 0D ', 6I9)") rank 108 111 CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) ) 109 112 ELSE IF ( nj_src == 1 ) THEN 113 l_src_is1D = .TRUE. 110 114 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 1D ', 6I9)") rank 111 115 CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(:,1) ) 112 116 ELSE 117 l_src_is2D = .TRUE. 113 118 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank 114 119 CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) ) … … 129 134 130 135 !< Read area on the source grid 131 ALLOCATE ( area_src (ni_src, nj_src) )132 136 IF ( l_use_area ) THEN 137 IF ( l_src_is0D ) ALLOCATE ( area_src ( 1 , 1 ) ) 138 IF ( l_src_is1D ) ALLOCATE ( area_src ( 1 , ni_src) ) 139 IF ( l_src_is2D ) ALLOCATE ( area_src (ni_src, nj_src) ) 133 140 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Receive field area_src')" ) rank 134 CALL xios_recv_field ("area_src", area_src) 135 ELSE 136 area_src (:,:) = 1 137 ENDIF 138 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src) !, SUM(area_src, mask=lmask_src) 139 140 !< Read mask on the destination grid 141 CALL xios_recv_field ("area_src", area_src(:,:)) 142 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src) 143 ENDIF 144 145 !< Read characteristics of the destination grid 141 146 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst')" ) rank 142 147 CALL xios_get_domain_attr ("domain_dst", ni=ni_dst, nj=nj_dst) 143 148 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst ', 6I7)") rank, ni_dst, nj_dst 149 150 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading type dst ', 6I9)") rank 151 CALL xios_get_domain_attr ("domain_dst", TYPE=type_dst ) 152 SELECT CASE ( TRIM (type_dst)) 153 CASE ( "rectilinear" ) 154 l_dst_is2D = .TRUE. 155 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Rectilinear dest domain 2D')") rank 156 CASE default 157 IF ( nj_dst == 1 .AND. ni_dst == 1) THEN 158 l_dst_is0D = .TRUE. 159 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 0D')") rank 160 ELSE IF ( nj_dst == 1 ) THEN 161 l_dst_is1D = .TRUE. 162 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 1D')") rank 163 ELSE 164 l_dst_is2D = .TRUE. 165 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 2D')") rank 166 ENDIF 167 END SELECT 168 169 !< Read mask on the destination grid 144 170 ALLOCATE ( imask_dst (ni_dst, nj_dst), lmask_dst (ni_dst, nj_dst) ) 145 171 IF ( l_mask_dst ) THEN … … 154 180 155 181 !< Read area on the destination grid 156 ALLOCATE ( area_dst (ni_dst, nj_dst) )157 182 IF ( l_use_area ) THEN 183 IF ( l_dst_is0D ) ALLOCATE ( area_dst ( 1 , 1 ) ) 184 IF ( l_dst_is1D ) ALLOCATE ( area_dst ( 1 , ni_dst) ) 185 IF ( l_dst_is2D ) ALLOCATE ( area_dst (ni_dst, nj_dst) ) 158 186 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- receive field area_dst')" ) rank 159 CALL xios_recv_field ("area_dst", area_dst) 160 ELSE 161 area_dst (:,:) = 1.0 162 ENDIF 163 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Counting mask_dst : ', 2E15.3)" ) rank, SUM(area_dst) !, SUM(area_dst,mask=lmask_dst) 164 187 CALL xios_recv_field ("area_dst", area_dst(:,:)) 188 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_dst : ', 2E15.3)" ) rank, SUM(area_dst) 189 ENDIF 190 165 191 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- End interpol_read (1)')") rank 166 192 CALL xios_context_finalize () … … 178 204 IF ( l_use_area ) CALL xios_set_domain_attr ("domain_src", area =area_src ) 179 205 !CALL xios_set_domain_attr ("domain_src", radius= 6371229.0 ) 180 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- get attributes domain_src')" ) rank206 WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Get attributes domain_dst')" ) rank 181 207 IF ( l_mask_dst ) CALL xios_set_domain_attr ("domain_dst", mask_2d=lmask_dst) 182 208 IF ( l_use_area ) CALL xios_set_domain_attr ("domain_dst", area =area_dst )
Note: See TracChangeset
for help on using the changeset viewer.