Changeset 15487 for NEMO/branches/UKMO/NEMO_4.0.4_generic_obs
- Timestamp:
- 2021-11-09T16:27:42+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE
- Files:
-
- 9 edited
-
DYN/dynspg_ts.F90 (modified) (2 diffs)
-
OBS/obs_bias.F90 (modified) (7 diffs)
-
OBS/obs_oper.F90 (modified) (6 diffs)
-
OBS/obs_prep.F90 (modified) (9 diffs)
-
OBS/obs_profiles_def.F90 (modified) (1 diff)
-
OBS/obs_read_altbias.F90 (modified) (1 diff)
-
OBS/obs_read_surf.F90 (modified) (3 diffs)
-
OBS/obs_surf_def.F90 (modified) (3 diffs)
-
OBS/obs_write.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/DYN/dynspg_ts.F90
r15248 r15487 51 51 USE agrif_oce 52 52 #endif 53 ! REMOVING THIS AS PER V3.6, BUT IS THIS THE BEST BRANCH TO DO IT IN?54 !#if defined key_asminc55 ! USE asminc ! Assimilation increment56 !#endif57 53 ! 58 54 USE in_out_manager ! I/O manager … … 342 338 ENDIF 343 339 ! 344 ! REMOVING THIS AS PER V3.6, BUT IS THIS THE BEST BRANCH TO DO IT IN?345 !#if defined key_asminc346 ! ! != Add the IAU weighted SSH increment =!347 ! ! ! ------------------------------------ !348 ! IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN349 ! zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)350 ! ENDIF351 !#endif352 340 ! != Fill boundary data arrays for AGRIF 353 341 ! ! ------------------------------------ -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_bias.F90
r15187 r15487 115 115 ENDIF 116 116 117 IF (lwp)WRITE(numout,*)118 IF (lwp)WRITE(numout,*) 'obs_app_bias : '119 IF (lwp)WRITE(numout,*) '----------------- '117 IF (lwp) WRITE(numout,*) 118 IF (lwp) WRITE(numout,*) 'obs_app_bias : ' 119 IF (lwp) WRITE(numout,*) '----------------- ' 120 120 IF ( ll_extvar ) THEN 121 IF (lwp)WRITE(numout,*) 'Read observation bias for ', TRIM(obsdata%cextvars(kvar))121 IF (lwp) WRITE(numout,*) 'Read observation bias for ', TRIM(obsdata%cextvars(kvar)) 122 122 ELSE 123 IF (lwp)WRITE(numout,*) 'Read observation bias for ', TRIM(obsdata%cvars(kvar))123 IF (lwp) WRITE(numout,*) 'Read observation bias for ', TRIM(obsdata%cvars(kvar)) 124 124 ENDIF 125 125 126 126 ! Open and read the files 127 z_obsbias(:,:,:) =0.0_wp127 z_obsbias(:,:,:) = 0.0_wp 128 128 DO jtype = 1, knumtypes 129 129 130 numobsbias =0131 IF (lwp)WRITE(numout,*) 'Opening ',cl_bias_files(jtype)130 numobsbias = 0 131 IF (lwp) WRITE(numout,*) 'Opening ', cl_bias_files(jtype) 132 132 CALL iom_open( cl_bias_files(jtype), numobsbias, ldstop=.FALSE. ) 133 133 IF (numobsbias > 0) THEN … … 138 138 !so have to use NETCDF 139 139 !routines directly - should be upgraded in the future 140 iret =NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile)140 iret = NF90_OPEN(TRIM(cl_bias_files(jtype)), NF90_NOWRITE, incfile) 141 141 IF ( .NOT. ll_extvar ) THEN 142 142 iret=NF90_GET_ATT( incfile, NF90_GLOBAL, TRIM(obsdata%cvars(kvar))//"_source", & … … 144 144 ibiastypes(jtype) = ifile_source 145 145 ENDIF 146 iret =NF90_CLOSE(incfile)146 iret = NF90_CLOSE(incfile) 147 147 IF ( iret /= 0 ) CALL ctl_stop( & 148 148 'obs_app_bias : Cannot read bias type from file '// & … … 196 196 & zmask_tmp(2,2,inumtype), & 197 197 & zbias( 2,2,inumtype ) ) 198 jt =1198 jt = 1 199 199 DO jobs = 1, obsdata%nsurf 200 200 IF ( obsdata%ntyp(jobs) == ibiastypes(jtype) ) THEN … … 211 211 & igrdi_tmp(:,:,:), igrdj_tmp(:,:,:), & 212 212 & z_obsbias(:,:,jtype), zbias(:,:,:) ) 213 jt =1213 jt = 1 214 214 DO jobs = 1, obsdata%nsurf 215 215 IF ( ( obsdata%ntyp(jobs) == ibiastypes(jtype) ) .OR. & … … 230 230 obsdata%robs(jobs,kvar) = obsdata%robs(jobs,kvar) - zext(1) 231 231 ENDIF 232 jt =jt+1232 jt = jt + 1 233 233 ENDIF 234 234 END DO … … 254 254 WRITE(numout,*) "Bias correction applied successfully" 255 255 IF ( .NOT. ll_extvar ) THEN 256 WRITE(numout,*) "Obs types: ", ibiastypes(:), &257 256 WRITE(numout,*) "Obs types: ", ibiastypes(:), & 257 & " Have all been bias corrected" 258 258 ENDIF 259 259 ENDIF -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_oper.F90
r15285 r15487 210 210 zdaystp = 1.0 / REAL( kdaystp ) 211 211 IF ( idayend == 0 ) THEN 212 IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ', kt212 IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ', kt 213 213 CALL FLUSH(numout) 214 214 DO jk = 1, jpk … … 658 658 ! Added kt == 0 test to catch restart case 659 659 IF ( ( imeanend == 1 ) .OR. ( kt == 0 ) ) THEN 660 IF (lwp) WRITE(numout,*) 'Reset surfdataqc%vdmean on time-step: ', kt660 IF (lwp) WRITE(numout,*) 'Reset surfdataqc%vdmean on time-step: ', kt 661 661 DO jj = 1, jpj 662 662 DO ji = 1, jpi … … 667 667 668 668 ! On each time-step, increment the field for computing time mean 669 IF (lwp) WRITE(numout,*)'Accumulating surfdataqc%vdmean on time-step: ', kt669 IF (lwp) WRITE(numout,*)'Accumulating surfdataqc%vdmean on time-step: ', kt 670 670 DO jj = 1, jpj 671 671 DO ji = 1, jpi … … 678 678 IF ( imeanend == 0 ) THEN 679 679 zmeanstp = 1.0 / REAL( kmeanstp ) 680 IF (lwp) WRITE(numout,*)'Calculating surfdataqc%vdmean time mean on time-step: ',kt,' with weight: ',zmeanstp 680 IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean time mean on time-step: ', & 681 & kt, ' with weight: ', zmeanstp 681 682 DO jj = 1, jpj 682 683 DO ji = 1, jpi … … 732 733 zdaystp = 1.0 / REAL( kdaystp ) 733 734 IF ( idayend == 0 ) THEN 734 IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ', kt735 IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ', kt 735 736 DO jj = 1, jpj 736 737 DO ji = 1, jpi … … 817 818 IF ( imeanend == 0 ) THEN 818 819 ALLOCATE( zsurfm(imaxifp,imaxjfp,isurf) ) 819 IF (lwp) WRITE(numout,*)' Interpolating the time mean values on time step: ', kt820 IF (lwp) WRITE(numout,*)' Interpolating the time mean values on time step: ', kt 820 821 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 821 822 & igrdi, igrdj, surfdataqc%vdmean(:,:,kvar), zsurfm ) -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_prep.F90
r15248 r15487 136 136 137 137 ! Set QC cutoff to optional value if provided 138 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff =kqc_cutoff138 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff = kqc_cutoff 139 139 140 140 ! ----------------------------------------------------------------------- … … 212 212 DO jvar = 1, surfdataqc%nvar 213 213 IF ( jvar == 1 ) THEN 214 cout1 =TRIM(surfdataqc%cvars(1))214 cout1 = TRIM(surfdataqc%cvars(1)) 215 215 ELSE 216 216 WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdataqc%cvars(jvar)) … … 245 245 WRITE(numout,*) ' Number of observations per time step :' 246 246 WRITE(numout,*) 247 WRITE(numout,'(10X,A,10X,A)') 'Time step',TRIM(cout1)248 WRITE(numout,'(10X,A,5X,A)') '---------','-----------------'247 WRITE(numout,'(10X,A,10X,A)') 'Time step', TRIM(cout1) 248 WRITE(numout,'(10X,A,5X,A)') '---------', '-----------------' 249 249 CALL FLUSH(numout) 250 250 ENDIF … … 377 377 378 378 ! Set QC cutoff to optional value if provided 379 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff =kqc_cutoff379 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff = kqc_cutoff 380 380 381 381 ! ----------------------------------------------------------------------- … … 515 515 & ilanvobsmpp(jvar) 516 516 IF (ld_nea) THEN 517 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (removed) = ', &517 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (removed) = ', & 518 518 & inlavobsmpp(jvar) 519 519 ELSE 520 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (kept) = ', &520 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (kept) = ', & 521 521 & inlavobsmpp(jvar) 522 522 ENDIF … … 530 530 ENDIF 531 531 ENDIF 532 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ', &532 WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ', & 533 533 & ibdyvobsmpp(jvar) 534 534 WRITE(numout,*) ' '//prodatqc%cvars(jvar)//' data accepted = ', & … … 832 832 !! * Local declarations 833 833 INTEGER :: jobs 834 INTEGER :: iqc_cutoff =255834 INTEGER :: iqc_cutoff = 255 835 835 836 836 !----------------------------------------------------------------------- … … 1122 1122 & ln_zps, & 1123 1123 & mbkt 1124 ! I THINK MBKT IS CORRECT (V3.6 WAS MBATHY) BUT CONFIRM 1124 1125 1125 !! * Arguments 1126 1126 INTEGER, INTENT(IN) :: kprofno ! Number of profiles … … 1274 1274 1275 1275 ! Calculate max T and W depths of 2x2 grid 1276 maxdept =zgdept(1,1,NINT(zbathy(1,1,jobs)),jobs)1277 maxdepw =zgdepw(1,1,NINT(zbathy(1,1,jobs))+1,jobs)1276 maxdept = zgdept(1,1,NINT(zbathy(1,1,jobs)),jobs) 1277 maxdepw = zgdepw(1,1,NINT(zbathy(1,1,jobs))+1,jobs) 1278 1278 DO jj = 1, 2 1279 1279 DO ji = 1, 2 -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_profiles_def.F90
r15224 r15487 783 783 DO ji = 1, prof%nprof 784 784 IF ( lvalid%luse(ji) ) THEN 785 inprof =inprof+1785 inprof = inprof + 1 786 786 DO jvar = 1, prof%nvar 787 787 DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar) -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_altbias.F90
r14075 r15487 116 116 numaltbias=0 117 117 118 IF (lwp)WRITE(numout,*) 'Opening ',bias_file118 IF (lwp) WRITE(numout,*) 'Opening ', bias_file 119 119 120 120 CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. ) -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_surf.F90
r15288 r15487 325 325 ENDIF 326 326 327 IF (lwp) WRITE(numout,*) 'Observation file contains ',inpfiles(jj)%nobs,' observations'327 IF (lwp) WRITE(numout,*) 'Observation file contains ', inpfiles(jj)%nobs, ' observations' 328 328 329 329 !------------------------------------------------------------------ … … 595 595 ityp(itype+1) = ityp(itype+1) + 1 596 596 ELSE 597 IF(lwp)WRITE(numout,*) 'WARNING:Increase jpsurfmaxtype in ',&598 & cpname597 IF(lwp)WRITE(numout,*) 'WARNING: Increase jpsurfmaxtype in ', & 598 & cpname 599 599 ENDIF 600 600 … … 665 665 DO jj = 1,8 666 666 IF ( itypmpp(jj) > 0 ) THEN 667 WRITE(numout,'(1X,A4,I4,A3,I10)') 'Type ', jj,' = ',itypmpp(jj)667 WRITE(numout,'(1X,A4,I4,A3,I10)') 'Type ', jj, ' = ', itypmpp(jj) 668 668 ENDIF 669 669 END DO -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_surf_def.F90
r15225 r15487 580 580 DO ji = 1, surf%nsurf 581 581 582 jj =surf%nsind(ji)582 jj = surf%nsind(ji) 583 583 584 584 oldsurf%mi(jj,:) = surf%mi(ji,:) … … 605 605 DO ji = 1, surf%nsurf 606 606 607 jj =surf%nsind(ji)607 jj = surf%nsind(ji) 608 608 609 609 oldsurf%robs(jj,jk) = surf%robs(ji,jk) … … 622 622 DO ji = 1, surf%nsurf 623 623 624 jj =surf%nsind(ji)624 jj = surf%nsind(ji) 625 625 626 626 oldsurf%rext(jj,jk) = surf%rext(ji,jk) -
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_write.F90
r15288 r15487 152 152 IF(lwp) THEN 153 153 WRITE(numout,*) 154 WRITE(numout,*) 'obs_wri_prof :'155 WRITE(numout,*) '~~~~~~~~~~~~~'156 WRITE(numout,*) 'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname)154 WRITE(numout,*) 'obs_wri_prof :' 155 WRITE(numout,*) '~~~~~~~~~~~~~' 156 WRITE(numout,*) 'Writing '//TRIM(clfiletype)//' feedback file : ', TRIM(clfname) 157 157 ENDIF 158 158 … … 369 369 IF(lwp) THEN 370 370 WRITE(numout,*) 371 WRITE(numout,*) 'obs_wri_surf :'372 WRITE(numout,*) '~~~~~~~~~~~~~'373 WRITE(numout,*) 'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname)371 WRITE(numout,*) 'obs_wri_surf :' 372 WRITE(numout,*) '~~~~~~~~~~~~~' 373 WRITE(numout,*) 'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ', TRIM(clfname) 374 374 ENDIF 375 375 … … 494 494 495 495 DO jvar = 1, fbdata%nvar 496 zsumx =0.0_wp497 zsumx2 =0.0_wp498 inumgoodobs =0496 zsumx = 0.0_wp 497 zsumx2 = 0.0_wp 498 inumgoodobs = 0 499 499 DO jo = 1, fbdata%nobs 500 500 DO jk = 1, fbdata%nlev … … 503 503 & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 504 504 505 zomb =fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar)506 zsumx =zsumx+zomb507 zsumx2 =zsumx2+zomb**2508 inumgoodobs =inumgoodobs+1505 zomb = fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 506 zsumx = zsumx + zomb 507 zsumx2 = zsumx2 + zomb**2 508 inumgoodobs = inumgoodobs + 1 509 509 ENDIF 510 510 ENDDO … … 516 516 517 517 IF (lwp) THEN 518 WRITE(numout,*) 'Type: ', fbdata%cname(jvar),' Total number of good observations: ',inumgoodobsmpp518 WRITE(numout,*) 'Type: ', fbdata%cname(jvar), ' Total number of good observations: ', inumgoodobsmpp 519 519 IF ( inumgoodobsmpp > 0 ) THEN 520 WRITE(numout,*) 'Overall mean obs minus model of the good observations: ', zsumx/inumgoodobsmpp521 WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ', sqrt( zsumx2/inumgoodobsmpp )520 WRITE(numout,*) 'Overall mean obs minus model of the good observations: ', zsumx/inumgoodobsmpp 521 WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ', sqrt( zsumx2/inumgoodobsmpp ) 522 522 ENDIF 523 523 WRITE(numout,*) ''
Note: See TracChangeset
for help on using the changeset viewer.
