Changeset 5704 for branches/2015/dev_r5072_UKMO2_OBS_simplification
- Timestamp:
- 2015-08-21T15:00:38+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r5682 r5704 137 137 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 138 138 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 139 REAL(wp), DIMENSION(jpi,jpj) :: &139 REAL(wp), POINTER, DIMENSION(:,:) :: & 140 140 & zglam1, & ! Model longitudes for profile variable 1 141 141 & zglam2 ! Model longitudes for profile variable 2 142 REAL(wp), DIMENSION(jpi,jpj) :: &142 REAL(wp), POINTER, DIMENSION(:,:) :: & 143 143 & zgphi1, & ! Model latitudes for profile variable 1 144 144 & zgphi2 ! Model latitudes for profile variable 2 145 REAL(wp), DIMENSION(jpi,jpj,jpk) :: &145 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 146 146 & zmask1, & ! Model land/sea mask associated with variable 1 147 147 & zmask2 ! Model land/sea mask associated with variable 2 … … 159 159 & nn_msshc, rn_mdtcorr, rn_mdtcutoff, & 160 160 & nn_profdavtypes 161 162 CALL wrk_alloc( jpi, jpj, zglam1 ) 163 CALL wrk_alloc( jpi, jpj, zglam2 ) 164 CALL wrk_alloc( jpi, jpj, zgphi1 ) 165 CALL wrk_alloc( jpi, jpj, zgphi2 ) 166 CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 167 CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 161 168 162 169 !----------------------------------------------------------------------- … … 409 416 CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 410 417 & llvar1, llvar2, & 418 & jpi, jpj, jpk, & 411 419 & zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2, & 412 420 & ln_nea, kdailyavtypes = nn_profdavtypes ) … … 451 459 452 460 ENDIF 461 462 CALL wrk_dealloc( jpi, jpj, zglam1 ) 463 CALL wrk_dealloc( jpi, jpj, zglam2 ) 464 CALL wrk_dealloc( jpi, jpj, zgphi1 ) 465 CALL wrk_dealloc( jpi, jpj, zgphi2 ) 466 CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 467 CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 453 468 454 469 END SUBROUTINE dia_obs_init … … 500 515 INTEGER :: jtype ! Data loop variable 501 516 INTEGER :: jvar ! Variable number 502 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 517 INTEGER :: ji, jj ! Loop counters 518 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 503 519 & zprofvar1, & ! Model values for 1st variable in a prof ob 504 520 & zprofvar2 ! Model values for 2nd variable in a prof ob 505 REAL(wp), DIMENSION(jpi,jpj,jpk) :: &521 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 506 522 & zprofmask1, & ! Mask associated with zprofvar1 507 523 & zprofmask2 ! Mask associated with zprofvar2 508 REAL(wp), DIMENSION(jpi,jpj):: &524 REAL(wp), POINTER, DIMENSION(:,:) :: & 509 525 & zsurfvar ! Model values equivalent to surface ob. 510 REAL(wp), DIMENSION(jpi,jpj) :: &526 REAL(wp), POINTER, DIMENSION(:,:) :: & 511 527 & zglam1, & ! Model longitudes for prof variable 1 512 528 & zglam2, & ! Model longitudes for prof variable 2 … … 518 534 LOGICAL :: llnightav ! Logical for calculating night-time average 519 535 536 !Allocate local work arrays 537 CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 ) 538 CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 ) 539 CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 ) 540 CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 541 CALL wrk_alloc( jpi, jpj, zsurfvar ) 542 CALL wrk_alloc( jpi, jpj, zglam1 ) 543 CALL wrk_alloc( jpi, jpj, zglam2 ) 544 CALL wrk_alloc( jpi, jpj, zgphi1 ) 545 CALL wrk_alloc( jpi, jpj, zgphi2 ) 520 546 #if ! defined key_lim2 && ! defined key_lim3 521 547 CALL wrk_alloc(jpi,jpj,frld) … … 591 617 #if defined key_lim2 || defined key_lim3 592 618 CASE('sic') 593 zsurfvar(:,:) = 1._wp - frld(:,:) 619 IF ( kstp == 0 ) THEN 620 IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN 621 CALL ctl_warn( 'Sea-ice not initialised on zeroth '// & 622 & 'time-step but some obs are valid then.' ) 623 WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), & 624 & ' sea-ice obs will be missed' 625 ENDIF 626 surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + & 627 & surfdataqc(jtype)%nsstp(1) 628 CYCLE 629 ELSE 630 zsurfvar(:,:) = 1._wp - frld(:,:) 631 ENDIF 632 594 633 llnightav = .FALSE. 595 634 #endif … … 604 643 ENDIF 605 644 645 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 ) 646 CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 ) 647 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 ) 648 CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 649 CALL wrk_dealloc( jpi, jpj, zsurfvar ) 650 CALL wrk_dealloc( jpi, jpj, zglam1 ) 651 CALL wrk_dealloc( jpi, jpj, zglam2 ) 652 CALL wrk_dealloc( jpi, jpj, zgphi1 ) 653 CALL wrk_dealloc( jpi, jpj, zgphi2 ) 606 654 #if ! defined key_lim2 && ! defined key_lim3 607 CALL wrk_dealloc(jpi,jpj,frld) 655 CALL wrk_dealloc(jpi,jpj,frld) 608 656 #endif 609 657 610 658 END SUBROUTINE dia_obs 611 659 612 SUBROUTINE dia_obs_wri 660 SUBROUTINE dia_obs_wri 613 661 !!---------------------------------------------------------------------- 614 662 !! *** ROUTINE dia_obs_wri *** … … 618 666 !! ** Method : Call observation diagnostic output routines 619 667 !! 620 !! ** Action : 668 !! ** Action : 621 669 !! 622 670 !! History : … … 628 676 !! ! 15-08 (M. Martin) Combined writing for prof and surf types 629 677 !!---------------------------------------------------------------------- 678 !! * Modules used 679 USE obs_rot_vel ! Rotation of velocities 680 630 681 IMPLICIT NONE 631 682 632 683 !! * Local declarations 633 684 INTEGER :: jtype ! Data set loop variable 685 INTEGER :: jo, jvar, jk 686 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 687 & zu, & 688 & zv 634 689 635 690 !----------------------------------------------------------------------- … … 640 695 641 696 DO jtype = 1, nproftypes 697 698 IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 699 700 ! For velocity data, rotate the model velocities to N/S, E/W 701 ! using the compressed data structure. 702 ALLOCATE( & 703 & zu(profdataqc(jtype)%nvprot(1)), & 704 & zv(profdataqc(jtype)%nvprot(2)) & 705 & ) 706 707 CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 708 709 DO jo = 1, profdataqc(jtype)%nprof 710 DO jvar = 1, 2 711 DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar) 712 713 IF ( jvar == 1 ) THEN 714 profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk) 715 ELSE 716 profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk) 717 ENDIF 718 719 END DO 720 END DO 721 END DO 722 723 DEALLOCATE( zu ) 724 DEALLOCATE( zv ) 725 726 END IF 642 727 643 728 CALL obs_prof_decompress( profdataqc(jtype), & 644 729 & profdata(jtype), .TRUE., numout ) 645 730 646 CALL obs_wri_prof( profdata(jtype) , nn_2dint)731 CALL obs_wri_prof( profdata(jtype) ) 647 732 648 733 END DO -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r3294 r5704 35 35 CONTAINS 36 36 37 SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kp k, kgrdi, kgrdj, &37 SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 38 38 & pval, pgval, kproc ) 39 39 !!---------------------------------------------------------------------- … … 57 57 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 58 58 INTEGER, INTENT(IN) :: kobs ! Local number of observations 59 INTEGER, INTENT(IN) :: kpi ! Number of points in i direction 60 INTEGER, INTENT(IN) :: kpj ! Number of points in j direction 59 61 INTEGER, INTENT(IN) :: kpk ! Number of levels 60 62 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & … … 63 65 INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 64 66 & kproc ! Precomputed processor for each i,j,iobs points 65 REAL(KIND=wp), DIMENSION( jpi,jpj,kpk), INTENT(IN) ::&67 REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 66 68 & pval ! Local 3D array to extract data from 67 69 REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& … … 73 75 IF (PRESENT(kproc)) THEN 74 76 75 CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kp k, kgrdi, &77 CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 76 78 & kgrdj, pval, pgval, kproc=kproc ) 77 79 78 80 ELSE 79 81 80 CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kp k, kgrdi, &82 CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 81 83 & kgrdj, pval, pgval ) 82 84 … … 85 87 ELSE 86 88 87 CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kp k, kgrdi, kgrdj, &89 CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 88 90 & pval, pgval ) 89 91 … … 92 94 END SUBROUTINE obs_int_comm_3d 93 95 94 SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, k grdi, kgrdj, pval, pgval, &96 SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, kgrdi, kgrdj, pval, pgval, & 95 97 & kproc ) 96 98 !!---------------------------------------------------------------------- … … 111 113 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 112 114 INTEGER, INTENT(IN) :: kobs ! Local number of observations 115 INTEGER, INTENT(IN) :: kpi ! Number of model grid points in i direction 116 INTEGER, INTENT(IN) :: kpj ! Number of model grid points in j direction 113 117 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 114 118 & kgrdi, & ! i,j indicies for each stencil … … 116 120 INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 117 121 & kproc ! Precomputed processor for each i,j,iobs points 118 REAL(KIND=wp), DIMENSION( jpi,jpj), INTENT(IN) ::&122 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::& 119 123 & pval ! Local 3D array to extra data from 120 124 REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::& … … 136 140 IF (PRESENT(kproc)) THEN 137 141 138 CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &142 CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 139 143 & zgval, kproc=kproc ) 140 144 ELSE 141 145 142 CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &146 CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 143 147 & zgval ) 144 148 … … 154 158 END SUBROUTINE obs_int_comm_2d 155 159 156 SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kp k, kgrdi, kgrdj, &160 SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 157 161 & pval, pgval, kproc ) 158 162 !!---------------------------------------------------------------------- … … 174 178 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 175 179 INTEGER, INTENT(IN) :: kobs ! Local number of observations 180 INTEGER, INTENT(IN) :: kpi ! Number of model points in i direction 181 INTEGER, INTENT(IN) :: kpj ! Number of model points in j direction 176 182 INTEGER, INTENT(IN) :: kpk ! Number of levels 177 183 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & … … 180 186 INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 181 187 & kproc ! Precomputed processor for each i,j,iobs points 182 REAL(KIND=wp), DIMENSION( jpi,jpj,kpk), INTENT(IN) ::&188 REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 183 189 & pval ! Local 3D array to extract data from 184 190 REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& … … 207 213 208 214 ! Check valid points 209 215 210 216 IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. & 211 217 & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN 212 218 213 219 CALL ctl_stop( 'Error in obs_int_comm_3d_global', & 214 220 & 'Point outside global domain' ) 215 221 216 222 ENDIF 217 223 … … 323 329 END SUBROUTINE obs_int_comm_3d_global 324 330 325 SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kp k, kgrdi, kgrdj, &331 SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 326 332 & pval, pgval ) 327 333 !!---------------------------------------------------------------------- … … 343 349 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 344 350 INTEGER, INTENT(IN) :: kobs ! Local number of observations 351 INTEGER, INTENT(IN) :: kpi ! Number of model points in i direction 352 INTEGER, INTENT(IN) :: kpj ! Number of model points in j direction 345 353 INTEGER, INTENT(IN) :: kpk ! Number of levels 346 354 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 347 355 & kgrdi, & ! i,j indicies for each stencil 348 356 & kgrdj 349 REAL(KIND=wp), DIMENSION( jpi,jpj,kpk), INTENT(IN) ::&357 REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 350 358 & pval ! Local 3D array to extract data from 351 359 REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r5682 r5704 283 283 END DO 284 284 285 CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, plam1, zglam1 )286 CALL obs_int_comm_2d( 2, 2, ipro, igrdi1, igrdj1, pphi1, zgphi1 )287 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi1, igrdj1, pmask1, zmask1 )288 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi1, igrdj1, pvar1, zint1 )285 CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 286 CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 287 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 288 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1, zint1 ) 289 289 290 CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, plam2, zglam2 )291 CALL obs_int_comm_2d( 2, 2, ipro, igrdi2, igrdj2, pphi2, zgphi2 )292 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi2, igrdj2, pmask2, zmask2 )293 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi2, igrdj2, pvar2, zint2 )290 CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 291 CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 292 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 293 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2, zint2 ) 294 294 295 295 ! At the end of the day also get interpolated means … … 301 301 & ) 302 302 303 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi1, igrdj1, &303 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 304 304 & prodatqc%vdmean(:,:,:,1), zinm1 ) 305 CALL obs_int_comm_3d( 2, 2, ipro, kp k, igrdi2, igrdj2, &305 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 306 306 & prodatqc%vdmean(:,:,:,2), zinm2 ) 307 307 … … 649 649 END DO 650 650 651 CALL obs_int_comm_2d( 2, 2, isurf, &651 CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 652 652 & igrdi, igrdj, glamt, zglam ) 653 CALL obs_int_comm_2d( 2, 2, isurf, &653 CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 654 654 & igrdi, igrdj, gphit, zgphi ) 655 CALL obs_int_comm_2d( 2, 2, isurf, &655 CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 656 656 & igrdi, igrdj, psurfmask, zmask ) 657 CALL obs_int_comm_2d( 2, 2, isurf, &657 CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, & 658 658 & igrdi, igrdj, psurf, zsurf ) 659 659 … … 665 665 & ) 666 666 667 CALL obs_int_comm_2d( 2, 2, isurf, igrdi, igrdj, &667 CALL obs_int_comm_2d( 2, 2, isurf, kpi, kpj, igrdi, igrdj, & 668 668 & surfdataqc%vdmean(:,:), zsurfm ) 669 669 -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r5682 r5704 234 234 235 235 SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 236 & kpi, kpj, kpk, & 236 237 & zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2, & 237 238 & ld_nea, kdailyavtypes ) … … 264 265 LOGICAL, INTENT(IN) :: ld_var2 265 266 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 267 INTEGER, INTENT(IN) :: kpi, kpj, kpk ! Local domain sizes 266 268 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 267 269 & kdailyavtypes ! Types for daily averages 268 REAL(wp), INTENT(IN), DIMENSION( jpi,jpj,jpk) :: &270 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 269 271 & zmask1, & 270 272 & zmask2 271 REAL(wp), INTENT(IN), DIMENSION( jpi,jpj) :: &273 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 272 274 & pglam1, & 273 275 & pglam2, & … … 953 955 END DO 954 956 955 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk )956 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam )957 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi )957 CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk ) 958 CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam ) 959 CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 958 960 959 961 DO jobs = 1, kobsno … … 1128 1130 END DO 1129 1131 1130 CALL obs_int_comm_3d( 2, 2, kprofno, kp k, igrdi, igrdj, pmask, zgmsk )1131 CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam )1132 CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi )1132 CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk ) 1133 CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 1134 CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 1133 1135 1134 1136 DO jobs = 1, kprofno -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r5682 r5704 164 164 END DO 165 165 166 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &166 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 167 167 & igrdi, igrdj, glamt, zglam ) 168 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &168 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 169 169 & igrdi, igrdj, gphit, zgphi ) 170 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &170 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 171 171 & igrdi, igrdj, tmask(:,:,1), zmask ) 172 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, &172 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 173 173 & igrdi, igrdj, z_altbias, zbias ) 174 174 -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r5682 r5704 124 124 & itypvar2mpp 125 125 INTEGER, DIMENSION(:), ALLOCATABLE :: & 126 & iobsi, & 127 & iobsj, & 128 & iproc, & 126 & iobsi1, & 127 & iobsj1, & 128 & iproc1, & 129 & iobsi2, & 130 & iobsj2, & 131 & iproc2, & 129 132 & iindx, & 130 133 & ifileidx, & … … 298 301 299 302 IF ( inpfiles(jj)%nobs > 0 ) THEN 300 inpfiles(jj)%iproc = -1301 inpfiles(jj)%iobsi = -1302 inpfiles(jj)%iobsj = -1303 inpfiles(jj)%iproc(:,:) = -1 304 inpfiles(jj)%iobsi(:,:) = -1 305 inpfiles(jj)%iobsj(:,:) = -1 303 306 ENDIF 304 307 inowin = 0 … … 314 317 ALLOCATE( zlam(inowin) ) 315 318 ALLOCATE( zphi(inowin) ) 316 ALLOCATE( iobsi(inowin) ) 317 ALLOCATE( iobsj(inowin) ) 318 ALLOCATE( iproc(inowin) ) 319 ALLOCATE( iobsi1(inowin) ) 320 ALLOCATE( iobsj1(inowin) ) 321 ALLOCATE( iproc1(inowin) ) 322 ALLOCATE( iobsi2(inowin) ) 323 ALLOCATE( iobsj2(inowin) ) 324 ALLOCATE( iproc2(inowin) ) 319 325 inowin = 0 320 326 DO ji = 1, inpfiles(jj)%nobs … … 330 336 END DO 331 337 332 CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 338 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 339 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 340 & iproc1, 'T' ) 341 iobsi2(:) = iobsi1(:) 342 iobsj2(:) = iobsj1(:) 343 iproc2(:) = iproc1(:) 344 ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 345 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 346 & iproc1, 'U' ) 347 CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 348 & iproc2, 'V' ) 349 ENDIF 333 350 334 351 inowin = 0 … … 340 357 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 341 358 inowin = inowin + 1 342 inpfiles(jj)%iproc(ji,1) = iproc(inowin) 343 inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 344 inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 359 inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 360 inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 361 inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 362 inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 363 inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 364 inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 365 IF ( inpfiles(jj)%iproc(ji,1) /= & 366 & inpfiles(jj)%iproc(ji,2) ) THEN 367 CALL ctl_stop( 'Error in obs_read_prof:', & 368 & 'var1 and var2 observation on different processors') 369 ENDIF 345 370 ENDIF 346 371 END DO 347 DEALLOCATE( zlam, zphi, iobsi , iobsj, iproc)372 DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 348 373 349 374 DO ji = 1, inpfiles(jj)%nobs … … 547 572 548 573 ! Coordinate search parameters 549 profdata%mi (iprof,:) = inpfiles(jj)%iobsi(ji,1) 550 profdata%mj (iprof,:) = inpfiles(jj)%iobsj(ji,1) 574 profdata%mi (iprof,1) = inpfiles(jj)%iobsi(ji,1) 575 profdata%mj (iprof,1) = inpfiles(jj)%iobsj(ji,1) 576 profdata%mi (iprof,2) = inpfiles(jj)%iobsi(ji,2) 577 profdata%mj (iprof,2) = inpfiles(jj)%iobsj(ji,2) 551 578 552 579 ! Profile WMO number … … 633 660 profdata%var(1)%nvlidx(ivar1t) = ij 634 661 635 ! Profile potentialvar1 value662 ! Profile var1 value 636 663 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 637 664 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN … … 658 685 659 686 ! Profile insitu T value 660 profdata%var(1)%vext(ivar1t,1) = & 661 & inpfiles(jj)%pext(ij,ji,1) 687 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 688 profdata%var(1)%vext(ivar1t,1) = & 689 & inpfiles(jj)%pext(ij,ji,1) 690 ENDIF 662 691 663 692 ENDIF -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
r5682 r5704 197 197 ENDIF 198 198 199 IF (lwp) WRITE(numout,*)'Observation file contains ',inpfiles(jj)%nobs,' observations' 200 199 201 !------------------------------------------------------------------ 200 202 ! Change longitude (-180,180) … … 398 400 surfdata%mj (iobs) = inpfiles(jj)%iobsj(ji,1) 399 401 402 ! WMO number 403 surfdata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji) 404 400 405 ! Instrument type 401 406 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r5682 r5704 108 108 109 109 ! Remove the offset between the MDT used with the sla and the model MDT 110 IF( nn_msshc == 1 .OR. nn_msshc == 2 ) CALL obs_offset_mdt( z_mdt, zfill ) 110 IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 111 & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 111 112 112 113 ! Intepolate the MDT already on the model grid at the observation point … … 134 135 END DO 135 136 136 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, glamt , zglam )137 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, gphit , zgphi )138 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, mdtmask, zmask )139 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, igrdi, igrdj, z_mdt , zmdtl )137 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt , zglam ) 138 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit , zgphi ) 139 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 140 CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt , zmdtl ) 140 141 141 142 DO jobs = 1, sladata%nsurf … … 168 169 CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 169 170 IF(lwp)WRITE(numout,*) ' ------------- ' 170 CALL FLUSH(numout)171 171 ! 172 172 END SUBROUTINE obs_rea_mdt 173 173 174 174 175 SUBROUTINE obs_offset_mdt( mdt, zfill )175 SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 176 176 !!--------------------------------------------------------------------- 177 177 !! … … 186 186 !! ** Action : 187 187 !!---------------------------------------------------------------------- 188 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: mdt ! MDT used on the model grid 189 REAL(wp) , INTENT(in ) :: zfill 188 INTEGER, INTENT(IN) :: kpi, kpj 189 REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: mdt ! MDT used on the model grid 190 REAL(wp) , INTENT(IN ) :: zfill 190 191 ! 191 192 INTEGER :: ji, jj -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r3294 r5704 140 140 END DO 141 141 142 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &142 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 143 143 & glamu, zglamu ) 144 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &144 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 145 145 & gphiu, zgphiu ) 146 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &146 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 147 147 & umask(:,:,1), zmasku ) 148 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &148 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 149 149 & zsingu, zsinlu ) 150 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &150 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 151 151 & zcosgu, zcoslu ) 152 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &152 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 153 153 & glamv, zglamv ) 154 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &154 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 155 155 & gphiv, zgphiv ) 156 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &156 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 157 157 & vmask(:,:,1), zmaskv ) 158 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &158 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 159 159 & zsingv, zsinlv ) 160 CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &160 CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 161 161 & zcosgv, zcoslv ) 162 162 … … 195 195 DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 196 196 IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 197 & ( profdata%var( 1)%vmod(jk) /= fbrmdi ) ) THEN197 & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 198 198 pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 199 & profdata%var(2)%vmod(jk) * zsin 199 & profdata%var(2)%vmod(jk) * zsin 200 200 pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 201 201 & profdata%var(1)%vmod(jk) * zsin … … 204 204 pv(jk) = fbrmdi 205 205 ENDIF 206 206 207 END DO 207 208 -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r5682 r5704 27 27 USE obs_conv ! Conversion between units 28 28 USE obs_const 29 USE obs_rot_vel ! Rotation of velocities30 29 USE obs_mpp ! MPP support routines for observation diagnostics 31 30 USE lib_mpp ! MPP routines … … 55 54 CONTAINS 56 55 57 SUBROUTINE obs_wri_prof( profdata, k2dint,padd, pext )56 SUBROUTINE obs_wri_prof( profdata, padd, pext ) 58 57 !!----------------------------------------------------------------------- 59 58 !! … … 78 77 !! * Arguments 79 78 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 80 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation method81 79 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 82 80 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info … … 96 94 INTEGER :: iext 97 95 REAL(wp) :: zpres 98 REAL(wp), DIMENSION(:), ALLOCATABLE :: &99 & zu, &100 & zv101 96 102 97 IF ( PRESENT( padd ) ) THEN … … 156 151 157 152 clfiletype='velfb' 158 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )153 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 159 154 fbdata%cname(1) = profdata%cvars(1) 160 155 fbdata%cname(2) = profdata%cvars(2) … … 172 167 fbdata%caddunit(1,1) = 'm/s' 173 168 fbdata%caddunit(1,2) = 'm/s' 174 fbdata%caddname(2) = 'HxG'175 fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'176 fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'177 fbdata%caddunit(2,1) = 'm/s'178 fbdata%caddunit(2,2) = 'm/s'179 169 fbdata%cgrid(1) = 'U' 180 170 fbdata%cgrid(2) = 'V' 181 171 DO ja = 1, iadd 182 fbdata%caddname(2+ja) = padd%cdname(ja) 183 fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 184 fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 185 END DO 186 ALLOCATE( & 187 & zu(profdata%nvprot(1)), & 188 & zv(profdata%nvprot(2)) & 189 & ) 190 CALL obs_rotvel( profdata, k2dint, zu, zv ) 172 fbdata%caddname(1+ja) = padd%cdname(ja) 173 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 174 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 175 END DO 191 176 192 177 END SELECT … … 203 188 ENDIF 204 189 205 ! Transform obs_prof data structure into obfb data structure190 ! Transform obs_prof data structure into obfb data structure 206 191 fbdata%cdjuldref = '19500101000000' 207 192 DO jo = 1, profdata%nprof … … 246 231 DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 247 232 ik = profdata%var(jvar)%nvlidx(jk) 248 IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 249 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 250 ELSE IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 251 IF ( jvar == 1 ) THEN 252 fbdata%padd(ik,jo,1,jvar) = zu(jk) 253 ELSE 254 fbdata%padd(ik,jo,1,jvar) = zv(jk) 255 ENDIF 256 fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk) 257 ENDIF 233 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 258 234 fbdata%pob(ik,jo,jvar) = profdata%var(jvar)%vobs(jk) 259 235 fbdata%pdep(ik,jo) = profdata%var(jvar)%vdep(jk) … … 277 253 & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 278 254 END DO 279 IF ( jvar == 1 ) THEN 255 IF ( ( jvar == 1 ) .AND. & 256 & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 280 257 fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 281 258 ENDIF … … 365 342 CALL init_obfbdata( fbdata ) 366 343 367 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, &368 & 2 + iadd, 1 + iext, .TRUE. )369 370 344 SELECT CASE ( TRIM(surfdata%cvars(1)) ) 371 345 CASE('SLA') 346 347 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 348 & 2 + iadd, 1 + iext, .TRUE. ) 372 349 373 350 clfiletype = 'slafb' … … 397 374 CASE('SST') 398 375 376 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 377 & 1 + iadd, iext, .TRUE. ) 378 399 379 clfiletype = 'sstfb' 400 380 fbdata%cname(1) = surfdata%cvars(1) … … 415 395 END DO 416 396 417 CASE('SEAICE') 397 CASE('ICECON') 398 399 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 400 & 1 + iadd, iext, .TRUE. ) 418 401 419 402 clfiletype = 'sicfb' … … 448 431 ENDIF 449 432 450 ! Transform obs_prof data structure into obfbdata structure433 ! Transform surf data structure into obfbdata structure 451 434 fbdata%cdjuldref = '19500101000000' 452 435 DO jo = 1, surfdata%nsurf … … 549 532 REAL(wp) :: zsumx2 550 533 REAL(wp) :: zomb 534 551 535 552 536 IF (lwp) THEN -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/SETTE/sette.sh
r5682 r5704 1159 1159 set_namelist namelist_cfg ln_sst .true. 1160 1160 set_namelist namelist_cfg ln_sla .true. 1161 set_namelist namelist_cfg ln_sic .true. 1162 set_namelist namelist_cfg ln_vel3d .true. 1161 1163 set_namelist namelist_cfg ln_bkgwri .true. 1162 1164 set_namelist namelist_cfg ln_trainc .true. … … 1195 1197 set_namelist namelist_cfg ln_sst .true. 1196 1198 set_namelist namelist_cfg ln_sla .true. 1199 set_namelist namelist_cfg ln_sic .true. 1200 set_namelist namelist_cfg ln_vel3d .true. 1197 1201 set_namelist namelist_cfg ln_bkgwri .true. 1198 1202 set_namelist namelist_cfg ln_trainc .true. -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate.F90
r4990 r5704 219 219 CALL set_spatial_coords_grid(lats,lons,nobs,nlats,nlons,FillValue_real) 220 220 ELSE 221 CALL set_spatial_coords(lats,lons,nobs, FillValue_real)221 CALL set_spatial_coords(lats,lons,nobs,nlats,nlons,FillValue_real) 222 222 END IF 223 223 -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/fbgenerate_coords.F90
r4990 r5704 26 26 27 27 28 SUBROUTINE set_spatial_coords(lats,lons,n, FillVal)28 SUBROUTINE set_spatial_coords(lats,lons,n,nlats,nlons,FillVal) 29 29 IMPLICIT NONE 30 30 INTEGER :: i, j, k, p, nlats, nlons, nlats_in_list, nlons_in_list … … 436 436 array(j,:,k) = array(j,1,k) 437 437 END DO 438 438 ! If single depth and only first profile has a value then set the rest based on that 439 ELSE IF ((n > 1) .AND. (m == 1) .AND. (array(1,2,k) == FillVal)) THEN 440 array(1,2:,k) = array(1,1,k) 439 441 ELSE 440 442 array(:,:,k) = array(:,:,k) -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/TOOLS/OBSTOOLS/src/test_fbgenerate.F90
r4990 r5704 392 392 lat_array_out(:) = (/1.0_fbdp/) 393 393 lon_array_out(:) = (/1.0_fbdp/) 394 CALL set_spatial_coords(lat_array_in,lon_array_in,1, FV_real)394 CALL set_spatial_coords(lat_array_in,lon_array_in,1,1,1,FV_real) 395 395 okay = test_arrays(lat_array_in,lat_array_out) 396 396 okay_too = test_arrays(lon_array_in,lon_array_out) … … 417 417 lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 418 418 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/) 419 CALL set_spatial_coords(lat_array_in,lon_array_in,4, FV_real)419 CALL set_spatial_coords(lat_array_in,lon_array_in,4,4,4,FV_real) 420 420 okay = test_arrays(lat_array_in,lat_array_out) 421 421 okay_too = test_arrays(lon_array_in,lon_array_out) … … 442 442 lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 443 443 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/) 444 CALL set_spatial_coords(lat_array_in,lon_array_in,3, FV_real)444 CALL set_spatial_coords(lat_array_in,lon_array_in,3,3,3,FV_real) 445 445 okay = test_arrays(lat_array_in,lat_array_out) 446 446 okay_too = test_arrays(lon_array_in,lon_array_out) … … 467 467 lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 468 468 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 469 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)469 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 470 470 okay = test_arrays(lat_array_in,lat_array_out) 471 471 okay_too = test_arrays(lon_array_in,lon_array_out) … … 492 492 lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 493 493 lon_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 494 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)494 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 495 495 okay = test_arrays(lat_array_in,lat_array_out) 496 496 okay_too = test_arrays(lon_array_in,lon_array_out) … … 517 517 lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 518 518 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 519 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)519 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 520 520 okay = test_arrays(lat_array_in,lat_array_out) 521 521 okay_too = test_arrays(lon_array_in,lon_array_out) … … 559 559 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,& 560 560 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 561 CALL set_spatial_coords(lat_array_in,lon_array_in,25, FV_real)561 CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 562 562 okay = test_arrays(lat_array_in,lat_array_out) 563 563 okay_too = test_arrays(lon_array_in,lon_array_out) … … 601 601 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,& 602 602 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 603 CALL set_spatial_coords(lat_array_in,lon_array_in,25, FV_real)603 CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 604 604 okay = test_arrays(lat_array_in,lat_array_out) 605 605 okay_too = test_arrays(lon_array_in,lon_array_out) … … 628 628 lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 629 629 lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 630 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)630 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 631 631 okay = test_arrays(lat_array_in,lat_array_out) 632 632 okay_too = test_arrays(lon_array_in,lon_array_out) … … 655 655 lat_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/) 656 656 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 657 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)657 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 658 658 okay = test_arrays(lat_array_in,lat_array_out) 659 659 okay_too = test_arrays(lon_array_in,lon_array_out) … … 698 698 1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,& 699 699 1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 700 CALL set_spatial_coords(lat_array_in,lon_array_in,25, FV_real)700 CALL set_spatial_coords(lat_array_in,lon_array_in,25,25,25,FV_real) 701 701 okay = test_arrays(lat_array_in,lat_array_out) 702 702 okay_too = test_arrays(lon_array_in,lon_array_out) … … 724 724 lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/) 725 725 lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/) 726 CALL set_spatial_coords(lat_array_in,lon_array_in,5, FV_real)726 CALL set_spatial_coords(lat_array_in,lon_array_in,5,5,5,FV_real) 727 727 okay = test_arrays(lat_array_in,lat_array_out) 728 728 okay_too = test_arrays(lon_array_in,lon_array_out) … … 764 764 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,& 765 765 10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp/) 766 CALL set_spatial_coords(lat_array_in,lon_array_in,20, FV_real)766 CALL set_spatial_coords(lat_array_in,lon_array_in,20,20,20,FV_real) 767 767 okay = test_arrays(lat_array_in,lat_array_out) 768 768 okay_too = test_arrays(lon_array_in,lon_array_out)
Note: See TracChangeset
for help on using the changeset viewer.