Changeset 11259
- Timestamp:
- 2019-07-11T18:29:19+02:00 (4 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_kd490/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 4 edited
-
diaobs.F90 (modified) (12 diffs)
-
obs_read_prof.F90 (modified) (6 diffs)
-
obs_read_surf.F90 (modified) (5 diffs)
-
obs_write.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_kd490/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r11253 r11259 230 230 & clproffiles, & ! Profile filenames 231 231 & clsurffiles ! Surface filenames 232 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars ! Expected variable names 232 233 233 234 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read … … 730 731 nextrprof(jtype) = 1 731 732 ALLOCATE(llvar(nvarsprof(jtype))) 733 ALLOCATE(clvars(nvarsprof(jtype))) 732 734 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 733 735 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 735 737 llvar(1) = ln_t3d 736 738 llvar(2) = ln_s3d 739 clvars(1) = 'POTM' 740 clvars(2) = 'PSAL' 737 741 zglam(:,:,1) = glamt(:,:) 738 742 zglam(:,:,2) = glamt(:,:) … … 745 749 nextrprof(jtype) = 2 746 750 ALLOCATE(llvar(nvarsprof(jtype))) 751 ALLOCATE(clvars(nvarsprof(jtype))) 747 752 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 748 753 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 750 755 llvar(1) = ln_vel3d 751 756 llvar(2) = ln_vel3d 757 clvars(1) = 'UVEL' 758 clvars(2) = 'VVEL' 752 759 zglam(:,:,1) = glamu(:,:) 753 760 zglam(:,:,2) = glamv(:,:) … … 760 767 nextrprof(jtype) = 0 761 768 ALLOCATE(llvar(nvarsprof(jtype))) 769 ALLOCATE(clvars(nvarsprof(jtype))) 762 770 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) 763 771 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 767 775 zgphi(:,:,1) = gphit(:,:) 768 776 zmask(:,:,:,1) = tmask(:,:,:) 777 IF ( TRIM(cobstypesprof(jtype)) == 'plchltot' ) THEN 778 clvars(1) = 'PLCHLTOT' 779 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pchltot' ) THEN 780 clvars(1) = 'PCHLTOT' 781 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pno3' ) THEN 782 clvars(1) = 'PNO3' 783 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'psi4' ) THEN 784 clvars(1) = 'PSI4' 785 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'ppo4' ) THEN 786 clvars(1) = 'PPO4' 787 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pdic' ) THEN 788 clvars(1) = 'PDIC' 789 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'palk' ) THEN 790 clvars(1) = 'PALK' 791 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pph' ) THEN 792 clvars(1) = 'PPH' 793 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'po2' ) THEN 794 clvars(1) = 'PO2' 795 ENDIF 769 796 ENDIF 770 797 … … 774 801 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 775 802 & rn_dobsini, rn_dobsend, llvar, & 776 & ln_ignmis, ln_s_at_t, .FALSE., &803 & ln_ignmis, ln_s_at_t, .FALSE., clvars, & 777 804 & kdailyavtypes = nn_profdavtypes ) 778 805 … … 788 815 & kdailyavtypes = nn_profdavtypes ) 789 816 790 DEALLOCATE( llvar )817 DEALLOCATE( llvar, clvars ) 791 818 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zglam ) 792 819 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zgphi ) … … 808 835 DO jtype = 1, nsurftypes 809 836 810 nvarssurf(jtype) = 1 811 nextrsurf(jtype) = 0 812 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 837 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) 838 nvarssurf(jtype) = 1 839 nextrsurf(jtype) = 2 840 ELSE 841 nvarssurf(jtype) = 1 842 nextrsurf(jtype) = 0 843 ENDIF 844 845 ALLOCATE( clvars( nvarssurf(jtype) ) ) 846 847 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 848 clvars(1) = 'SLA' 849 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 850 clvars(1) = 'SST' 851 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 852 clvars(1) = 'ICECONC' 853 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 854 clvars(1) = 'SSS' 855 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchltot' ) THEN 856 clvars(1) = 'SLCHLTOT' 857 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldia' ) THEN 858 clvars(1) = 'SLCHLDIA' 859 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnon' ) THEN 860 clvars(1) = 'SLCHLNON' 861 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldin' ) THEN 862 clvars(1) = 'SLCHLDIN' 863 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlmic' ) THEN 864 clvars(1) = 'SLCHLMIC' 865 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnan' ) THEN 866 clvars(1) = 'SLCHLNAN' 867 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlpic' ) THEN 868 clvars(1) = 'SLCHLPIC' 869 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'schltot' ) THEN 870 clvars(1) = 'SCHLTOT' 871 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphytot' ) THEN 872 clvars(1) = 'SLPHYTOT' 873 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphydia' ) THEN 874 clvars(1) = 'SLPHYDIA' 875 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphynon' ) THEN 876 clvars(1) = 'SLPHYNON' 877 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sspm' ) THEN 878 clvars(1) = 'SSPM' 879 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'skd490' ) THEN 880 clvars(1) = 'SKD490' 881 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sfco2' ) THEN 882 clvars(1) = 'SFCO2' 883 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'spco2' ) THEN 884 clvars(1) = 'SPCO2' 885 ENDIF 813 886 814 887 !Read in surface obs types … … 816 889 & clsurffiles(jtype,1:ifilessurf(jtype)), & 817 890 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 818 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 891 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype), & 892 & clvars ) 819 893 820 894 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) … … 840 914 841 915 ENDIF 916 917 DEALLOCATE( clvars ) 842 918 843 919 END DO -
branches/UKMO/dev_r5518_obs_oper_update_kd490/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r9306 r11259 46 46 & kvars, kextr, kstp, ddobsini, ddobsend, & 47 47 & ldvar, ldignmis, ldsatt, & 48 & ldmod, kdailyavtypes )48 & ldmod, cdvars, kdailyavtypes ) 49 49 !!--------------------------------------------------------------------- 50 50 !! … … 80 80 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 81 81 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 82 CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars 82 83 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 83 84 & kdailyavtypes ! Types of daily average observations … … 86 87 CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 87 88 CHARACTER(len=8) :: clrefdate 88 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 89 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvarsin 89 90 INTEGER :: jvar 90 91 INTEGER :: ji … … 221 222 222 223 IF ( jj == 1 ) THEN 223 ALLOCATE( clvars ( inpfiles(jj)%nvar ) )224 ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 224 225 DO ji = 1, inpfiles(jj)%nvar 225 clvars(ji) = inpfiles(jj)%cname(ji) 226 clvarsin(ji) = inpfiles(jj)%cname(ji) 227 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 228 CALL ctl_stop( 'Feedback file variables do not match', & 229 & ' expected variable names for this type' ) 230 ENDIF 226 231 END DO 227 232 ELSE 228 233 DO ji = 1, inpfiles(jj)%nvar 229 IF ( inpfiles(jj)%cname(ji) /= clvars (ji) ) THEN234 IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN 230 235 CALL ctl_stop( 'Feedback file variables not consistent', & 231 236 & ' with previous files for this type' ) … … 506 511 profdata%nprof = 0 507 512 profdata%nvprot(:) = 0 508 profdata%cvars(:) = clvars (:)513 profdata%cvars(:) = clvarsin(:) 509 514 iprof = 0 510 515 … … 805 810 ! Deallocate temporary data 806 811 !----------------------------------------------------------------------- 807 DEALLOCATE( ifileidx, iprofidx, zdat, clvars )812 DEALLOCATE( ifileidx, iprofidx, zdat, clvarsin ) 808 813 809 814 !----------------------------------------------------------------------- -
branches/UKMO/dev_r5518_obs_oper_update_kd490/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
r11255 r11259 40 40 SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 41 41 & kvars, kextr, kstp, ddobsini, ddobsend, & 42 & ldignmis, ldmod, ldnightav )42 & ldignmis, ldmod, ldnightav, cdvars ) 43 43 !!--------------------------------------------------------------------- 44 44 !! … … 73 73 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 74 74 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 75 CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars 75 76 76 77 !! * Local declarations 77 78 CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf' 78 79 CHARACTER(len=8) :: clrefdate 79 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 80 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvarsin 80 81 INTEGER :: ji 81 82 INTEGER :: jj … … 192 193 193 194 IF ( jj == 1 ) THEN 194 ALLOCATE( clvars ( inpfiles(jj)%nvar ) )195 ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 195 196 DO ji = 1, inpfiles(jj)%nvar 196 clvars(ji) = inpfiles(jj)%cname(ji) 197 clvarsin(ji) = inpfiles(jj)%cname(ji) 198 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 199 CALL ctl_stop( 'Feedback file variables do not match', & 200 & ' expected variable names for this type' ) 201 ENDIF 197 202 END DO 198 203 ELSE 199 204 DO ji = 1, inpfiles(jj)%nvar 200 IF ( inpfiles(jj)%cname(ji) /= clvars (ji) ) THEN205 IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN 201 206 CALL ctl_stop( 'Feedback file variables not consistent', & 202 207 & ' with previous files for this type' ) … … 369 374 370 375 iobs = 0 371 surfdata%cvars(:) = clvars (:)376 surfdata%cvars(:) = clvarsin(:) 372 377 IF ( ldmod .AND. ( TRIM( surfdata%cvars(1) ) == 'SLA' ) ) THEN 373 378 surfdata%cext(1) = 'SSH' … … 511 516 ! Deallocate temporary data 512 517 !----------------------------------------------------------------------- 513 DEALLOCATE( ifileidx, isurfidx, zdat, clvars )518 DEALLOCATE( ifileidx, isurfidx, zdat, clvarsin ) 514 519 515 520 !----------------------------------------------------------------------- -
branches/UKMO/dev_r5518_obs_oper_update_kd490/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r11253 r11259 500 500 clgrid = 'T' 501 501 502 CASE('SLCHLTOT' ,'LOGCHL','LogChl','logchl')502 CASE('SLCHLTOT') 503 503 504 504 clfiletype = 'slchltotfb' … … 591 591 clgrid = 'T' 592 592 593 CASE('SFCO2' ,'FCO2','fCO2','fco2')593 CASE('SFCO2') 594 594 595 595 clfiletype = 'sfco2fb'
Note: See TracChangeset
for help on using the changeset viewer.
