Changeset 2358
- Timestamp:
- 2010-11-04T19:14:01+01:00 (13 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 8 edited
- 1 moved
-
OBS/diaobs.F90 (modified) (1 diff)
-
OBS/obs_grd_bruteforce.h90 (moved) (moved from branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90) (2 diffs)
-
OBS/obs_grid.F90 (modified) (15 diffs)
-
OBS/obs_profiles.F90 (modified) (1 diff)
-
OBS/obs_seaice.F90 (modified) (1 diff)
-
OBS/obs_sla.F90 (modified) (1 diff)
-
OBS/obs_sst.F90 (modified) (1 diff)
-
OBS/obs_types.F90 (modified) (2 diffs)
-
SBC/fldread.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r2287 r2358 194 194 INTEGER :: jset 195 195 LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 196 197 !----------------------------------------------------------------------- 198 ! Force exit if AGRIF activated 199 !----------------------------------------------------------------------- 200 201 IF( lk_agrif ) THEN 202 CALL ctl_stop( 'dia_obs_init : key_diaobs and key_agrif cannot be used together' ) 203 ENDIF 196 204 197 205 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
r2267 r2358 1 SUBROUTINE obs_gr id_search_bruteforce( kpi, kpj, kpiglo, kpjglo, &2 & 3 & 4 & 5 & 1 SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, & 2 & kldi, klei, kldj, klej, & 3 & kmyproc, ktotproc, & 4 & pglam, pgphi, pmask, & 5 & kobs, plam, pphi, kobsi, kobsj, & 6 6 & kproc) 7 7 !!---------------------------------------------------------------------- 8 !! *** ROUTINE obs_gr id_search_bruteforce ***8 !! *** ROUTINE obs_grd_bruteforce *** 9 9 !! 10 10 !! ** Purpose : Search gridpoints to find the grid box containing … … 347 347 & ) 348 348 349 END SUBROUTINE obs_gr id_search_bruteforce349 END SUBROUTINE obs_grd_bruteforce -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
r2287 r2358 44 44 PRIVATE linquad, & ! Determine whether a point lies within a cell 45 45 & maxdist, & ! Find the maximum distance between 2 pts in a cell 46 & obs_gr id_search_bruteforce, & ! Find i, j on the ORCA grid from lat, lon47 & obs_gr id_search_lookup ! Find i, j on the ORCA grid from lat, lon quicker46 & obs_grd_bruteforce, & ! Find i, j on the ORCA grid from lat, lon 47 & obs_grd_lookup ! Find i, j on the ORCA grid from lat, lon quicker 48 48 49 49 !!* Module variables … … 75 75 & ixpos, & 76 76 & iypos, & 77 & iproc 77 & iprocn 78 78 79 79 ! Switches … … 98 98 !! ** Purpose : Search local gridpoints to find the grid box containing 99 99 !! the observations calls either 100 !! obs_gr id_search_bruteforce - the original brute force search100 !! obs_grd_bruteforce - the original brute force search 101 101 !! or 102 !! obs_gr id_search_lookup - uses a lookup table to do a fast102 !! obs_grd_lookup - uses a lookup table to do a fast 103 103 !!search 104 104 !!History : … … 122 122 123 123 IF ( ln_grid_search_lookup .AND. ( cdgrid == 'T' ) ) THEN 124 CALL obs_gr id_search_lookup( kobsin, plam, pphi, &124 CALL obs_grd_lookup( kobsin, plam, pphi, & 125 125 & kobsi, kobsj, kproc ) 126 126 ELSE 127 127 IF ( cdgrid == 'T' ) THEN 128 CALL obs_gr id_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &128 CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 129 129 & nldi, nlei,nldj, nlej, & 130 130 & nproc, jpnij, & … … 133 133 & kobsi, kobsj, kproc ) 134 134 ELSEIF ( cdgrid == 'U' ) THEN 135 CALL obs_gr id_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &135 CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 136 136 & nldi, nlei,nldj, nlej, & 137 137 & nproc, jpnij, & … … 140 140 & kobsi, kobsj, kproc ) 141 141 ELSEIF ( cdgrid == 'V' ) THEN 142 CALL obs_gr id_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &142 CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 143 143 & nldi, nlei,nldj, nlej, & 144 144 & nproc, jpnij, & … … 147 147 & kobsi, kobsj, kproc ) 148 148 ELSEIF ( cdgrid == 'F' ) THEN 149 CALL obs_gr id_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &149 CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 150 150 & nldi, nlei,nldj, nlej, & 151 151 & nproc, jpnij, & … … 162 162 END SUBROUTINE obs_grid_search 163 163 164 #include "obs_gr id_search_bruteforce.h90"164 #include "obs_grd_bruteforce.h90" 165 165 166 SUBROUTINE obs_gr id_search_lookup( kobs, plam, pphi, kobsi, kobsj, kproc )166 SUBROUTINE obs_grd_lookup( kobs, plam, pphi, kobsi, kobsj, kproc ) 167 167 !!---------------------------------------------------------------------- 168 !! *** ROUTINE obs_grid_ search_lookup ***168 !! *** ROUTINE obs_grid_lookup *** 169 169 !! 170 170 !! ** Purpose : Search local gridpoints to find the grid box containing 171 !! the observations (much faster then obs_gr id_search_bruteforce)171 !! the observations (much faster then obs_grd_bruteforce) 172 172 !! 173 173 !! ** Method : Call to linquad … … 361 361 END DO 362 362 363 if(lwp) WRITE(numout,*) 'obs_grid_ search_lookup do coordinate search using lookup table'363 if(lwp) WRITE(numout,*) 'obs_grid_lookup do coordinate search using lookup table' 364 364 365 365 !----------------------------------------------------------------------- … … 630 630 & ) 631 631 632 END SUBROUTINE obs_gr id_search_lookup632 END SUBROUTINE obs_grd_lookup 633 633 634 634 … … 758 758 & ixpos(nlons,nlats), & 759 759 & iypos(nlons,nlats), & 760 & iproc (nlons,nlats) &760 & iprocn(nlons,nlats) & 761 761 & ) 762 762 … … 818 818 END DO 819 819 820 CALL obs_gr id_search_bruteforce( jpi, jpj, jpiglo, jpjglo, &821 & 822 & 823 & 824 & 825 & 820 CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 821 & nldi, nlei,nldj, nlej, & 822 & nproc, jpnij, & 823 & glamt, gphit, tmask, & 824 & nlons*nlats, lonsi, latsi, & 825 & ixposi, iyposi, iproci ) 826 826 827 827 ! minimise file size by removing regions with no data from xypos file … … 873 873 & ixpos(nlons,nlats), & 874 874 & iypos(nlons,nlats), & 875 & iproc (nlons,nlats) &875 & iprocn(nlons,nlats) & 876 876 & ) 877 877 … … 880 880 ixpos(:,:) = ixposi(jimin:jimax,jjmin:jjmax) 881 881 iypos(:,:) = iyposi(jimin:jimax,jjmin:jjmax) 882 iproc (:,:) = iproci(jimin:jimax,jjmin:jjmax)882 iprocn(:,:) = iproci(jimin:jimax,jjmin:jjmax) 883 883 884 884 DEALLOCATE(lonsi,latsi,ixposi,iyposi,iproci) … … 1169 1169 1170 1170 IF (ln_grid_search_lookup) THEN 1171 DEALLOCATE( lons, lats, ixpos, iypos, iproc )1171 DEALLOCATE( lons, lats, ixpos, iypos, iprocn ) 1172 1172 ENDIF 1173 1173 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90
r2287 r2358 29 29 INTEGER :: nprofvars ! Total number of variables for profiles 30 30 INTEGER :: nprofextr ! Extra fields for each variable 31 !$AGRIF_DO_NOT_TREAT 31 32 TYPE(obs_prof), POINTER :: profdata(:) ! Initial profile data 32 33 TYPE(obs_prof), POINTER :: prodatqc(:) ! Profile data after quality control 34 !$AGRIF_END_DO_NOT_TREAT 33 35 34 36 INTEGER :: nvelosets ! Total number of velocity profile data sets 35 37 INTEGER :: nvelovars ! Total number of variables for profiles 36 38 INTEGER :: nveloextr ! Extra fields for each variable 39 !$AGRIF_DO_NOT_TREAT 37 40 TYPE(obs_prof), POINTER :: velodata(:) ! Initial velocity profile data 38 41 TYPE(obs_prof), POINTER :: veldatqc(:) ! Velocity profile data after quality control 42 !$AGRIF_END_DO_NOT_TREAT 39 43 END MODULE obs_profiles -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90
r2287 r2358 29 29 ! variables 30 30 INTEGER :: nseaicesets ! Number of seaicedata sets 31 !$AGRIF_DO_NOT_TREAT 31 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata ! Initial sea ice data 32 33 TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control 34 !$AGRIF_END_DO_NOT_TREAT 33 35 34 36 END MODULE obs_seaice -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90
r2287 r2358 28 28 ! variables 29 29 INTEGER :: nslasets ! Number of sladata sets 30 !$AGRIF_DO_NOT_TREAT 30 31 TYPE(obs_surf), POINTER, DIMENSION(:) :: sladata ! Initial SLA data 31 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: sladatqc ! SLA data after quality control 33 !$AGRIF_END_DO_NOT_TREAT 32 34 33 35 END MODULE obs_sla -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90
r2287 r2358 29 29 ! variables 30 30 INTEGER :: nsstsets ! Number of sstdata sets 31 !$AGRIF_DO_NOT_TREAT 31 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdata ! Initial SST data 32 33 TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdatqc ! SST data after quality control 34 !$AGRIF_END_DO_NOT_TREAT 33 35 34 36 END MODULE obs_sst -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
r2287 r2358 36 36 37 37 INTEGER, PUBLIC, PARAMETER :: ntyp1770 = 1023 38 CHARACTER(LEN=4), PUBLIC, DIMENSION(0:ntyp1770) :: cwmotyp177038 !RBbug useless ? CHARACTER(LEN=4), PUBLIC, DIMENSION(0:ntyp1770) :: cwmotyp1770 39 39 CHARACTER(LEN=80), PUBLIC, DIMENSION(0:ntyp1770) :: cwmonam1770 40 40 CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort … … 119 119 ctypshort(ji) = 'XBT' 120 120 121 IF ( ji < 1000 ) THEN122 WRITE(cwmotyp1770(ji),'(1X,I3.3)') ji123 ELSE124 WRITE(cwmotyp1770(ji),'(I4.4)') ji125 ENDIF121 ! IF ( ji < 1000 ) THEN 122 ! WRITE(cwmotyp1770(ji),'(1X,I3.3)') ji 123 ! ELSE 124 ! WRITE(cwmotyp1770(ji),'(I4.4)') ji 125 ! ENDIF 126 126 127 127 END DO -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2353 r2358 576 576 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 577 577 ENDIF 578 CASE (jpk)578 CASE DEFAULT 579 579 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 580 580 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) … … 995 995 CASE(1) 996 996 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 997 CASE (jpk)997 CASE DEFAULT 998 998 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 999 999 END SELECT … … 1042 1042 CASE(1) 1043 1043 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 1044 CASE (jpk)1044 CASE DEFAULT 1045 1045 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1046 1046 END SELECT … … 1052 1052 CASE(1) 1053 1053 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 1054 CASE (jpk)1054 CASE DEFAULT 1055 1055 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1056 1056 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
